TITLE TECO   V.21A - 18 AUG 70 - RC CLEMENTS/PMH/CM
SUBTTL TEXT EDITOR AND CORRECTOR

;COPYRIGHT DIGITAL EQUIPMENT CORP., 1969,1970, MAYNARD, MASS.


	VTECO=XWD 0,1021

;DEFAULT DEFINITIONS FOR ASSEMBLY SWITCHES & PARAMETERS
;THESE YIELD A SHARABLE (REENTRANT) PDP-10 TECO WITH
;CCL & TMPCOR UUO CAPABILITY

IFNDEF R,<R==1>
IFNDEF CCL,<CCL==1>
IFNDEF TEMP,<TEMP==1>
IFNDEF SAVEXT,<SAVEXT==SIXBIT /   SAV/>
IFNDEF BUFSIZ,<BUFSIZ==3+^D128>
IFNDEF LPDL,<LPDL==75>
IFNDEF LPF,<LPF==40>

;FOR ANY OTHER VERSION ASSEMBLE AS FOLLOWS:
;.R MACRO
;*TECO_TTY:,DSK:TECO.MAC
;R=0				(IF NON-REENTRANT TECO WANTED)
;CCL=0				(IF CCL NOT WANTED)
;TEMP=0				(IF TMPCOR UUO NOT WANTED)
;SAVEXT=SIXBIT /   DMP/		(IF PDP-6 VERSION WANTED)
;BUFSIZ=3+^D256			(IF 256-WORD I/O BUFFERS WANTED. ANY
;				 OTHER CONSTANT BESIDES 256 MAY BE USED.
;				 TECO USES STANDARD MONITOR BUFFERING,
;				 BUT IF ANY DEVICE HAS STANDARD BUFFERS
;				 LARGER THAN 128 WORDS, BUFSIZ MUST BE
;				 CHANGED SO THAT SUFFICIENT SPACE IS
;				 RESERVED.
;LPDL=N			(WHERE N>75, IF LARGER PDL WANTED)
;LPF=N				(WHERE N>40, IF LARGER Q-REGISTER PDL WANTED)
;^Z
;^Z
;ACCUMULATOR ASSIGNMENTS

	FF=0		;CONTROL FLAGS
	P=1		;PUSH DOWN POINTER
;*** A, AA AND B MUST BE CONTIGUOUS AND IN THAT ORDER ***
	A=2
	AA=3		;BYTE POINTER TO COMMAND BUFFER
;*** B AND E MUST BE ADJACENT AND B<11 ***
	B=4		;COMMAND BUFFER END ADDRESS
	E=5
	C=6
	D=7
	F=10
	T=11
;*** TT AND TT1 MUST BE ADJACENT ***
	TT=12
	TT1=13
	I=14
	OU=15
	CH=16
	PF=17


IFN R,<HISEG>

EXTERN	JOBREL,JOBSYM,JOBDDT,JOBFF,JOB41,JOBSA
INTERN	VTECO

JOBREN=124
JOBVER=137

INTERN	 JOBVER,JOBREN

LOC JOBVER			;JOB VERSION #
	EXP	VTECO
RELOC

LOC JOBREN
	EXP	REE		;WHERE TO GO ON REENTER COMMAND
RELOC
;CONTROL FLAGS
;RIGHT HALF

	ALTF=1		;ALT-MODE SEEN
	ARG2=2		;THERE IS A SECOND ARGUMENT
	ARG=4		;THERE IS AN ARGUMENT
	ITERF=10	;INSIDE AN ITERATION
	SLSL=20		;@ SEEN
	PCHFLG=40	;N SEARCH
	COLONF=100	;COLON SEEN
	SYLF=200	;SYLLABLE FLAG
	FINDR=2000	;LEFT ARROW SEARCH
	QMFLG=4000
	NOTF=10000	;^N SEARCH MODIFIER
	TRACEF=20000	;? SEEN
	SEQF=40000	;SEQUENCE NUMBER
	BELLF=100000	;^G SEEN
	DDTMF=200000	;NEED TO TYI IN DDT MODE
	FORM=400000	;A FORM FEED TERMINATED THE LAST YANK OR APPEND COMMAND

;LEFT HALF

IFN TEMP,<	TMPFLG=40>	;TMPCOR UUO ALLOWED
	FINF=100	;INPUT CLOSED BY EOF
	UREAD=200	;INPUT FILE IS OPEN
	UWRITE=400	;OUTPUT FILE IS OPEN
	UEBTMP=1000	;EB FUNCTION TEMPORARY FLAG
	FILWD=2000	;FILE WORD BEING ASSEMBLED.
	FEXTF=4000	;FILE EXT EXPECTED (.TYPED).
	FCSF=10000	;1 FOR BELIEVE LC LTRS
	UBAK=20000	;EB IN EFFECT
	GKTLKF=40000	;MESSAGE TYPE OUT IN GRABAK?
	TYOF=100000	;NEED TO OUTPUT A BUFFER
	TYOCTF=200000	;ALLOW CONTROL CHARS TYPED WITHOUT "^"
	CCLFLG=400000	;TECO COMMAND REQUESTS Y AFTER EB

OPDEF	TYPR1 [30B8]
OPDEF	ERROR [31B8]
;CALLI UUOS
	RESET=0
	DDTIN=1
	DDTOUT=3
	DEVCHR=4
	CORE=11
	EXIT=12
	TIMER=22
	GETPPN=24
	SWITCH=20
	UTPCLR=13
	PJOB=30
	REMAP=37
	GETTAB=41
	TMPCOR=44

	INCHN=2
	OUTCHN=3
	TTY=4		;CHANNEL FOR TTY IO
	CCLCHN=5	;CHANNEL FOR THE CCL TMP FILE

	IOEOT=2000
	DVMTA=20
	CNFTBL=11	;FOR GETTAB UUO
	STATES=17	;DITTO
	SERES5=3400	;DITTO

	GCTBL=100

INTERN JOBCOR
JOBCOR=133
IFE R,<	.ZZ=0
DEFINE U(A,B)<
A:	BLOCK	B
.ZZ=.ZZ+B
>
STARTA=TECO
LOC JOBCOR
	EXP	7777
RELOC
>
IFN R,<	ZZ=140
LOSIZ=4000		;IMPURE AREA AT LOAD TIME
HISIZ=4000		;SIZE OF PURE HALF OF TECO
DEFINE U(A,B)<
A=ZZ
ZZ=ZZ+B
>
STARTA=TECO		;TRY TO DO IT WITHOUT SPECIAL INITLZN
HITOP==<HIEND/2000>+1	;AMOUNT OF HI CORE
>
;PSEUDO RUN UUO IF NEEDED

IFN CCL,<
NORUN1:	IOWD	.-.,INHERE	;MODIFIED FOR LENGTH
	0
NORUN2:	CALLI	15,11
	CALLI	12		;NOT ENOUGH CORE TO GET COMPIL
	IN	CCLCHN,NORUN1	;READ THE FILE
	JRST	NORBLT		;TO THE ACS
	CALLI	12		;NO GOOD.

INHERE:				;WHERE CODE APPEARS
NORAC:				;WHERE TO READ AC DATA FROM
	PHASE	0
NORBLT:	BLT	NORTOP,.-.	;ADR MODIFIED
	CALLI	0
	AOS	1,JOBSA		;ADR + 1
	JRST	(1)		;START COMPIL
NORTOP:	XWD	INHERE+1,75	;MOVE COMPIL DOWN
	DEPHASE
>
;STARTUP TIME INITIALIZATION

	INTERNAL TECO
TECO:	IFN	CCL,<
	TDZA	B,B
	MOVNI	B,1		;THE CCL ENTRY
>
	CALLI	RESET		;INITIALIZE ALL IO
IFN R,<
	HRRZ	A,JOBREL	;SEE IF RUN IN AT LEAST 2K
	CAIGE	A,LOSIZ-1	;ENOUGH?
	MOVEI	A,LOSIZ-1	;NO.
	CALLI	A,CORE		;INSURE SPACE FOR VARIABLES
	CALLI	EXIT		;NO CORE
	SETZM	140
	MOVE	A,[XWD 140,141]
	BLT	A,@JOBREL
>
IFN CCL,<MOVEM	B,CCLSW>
	MOVE	A,LOC41		;SETUP UUO TRAP JOB41:=JSR ETYPER
	MOVEM	A,JOB41
	MOVE	P,[XWD -LPDL,PDL-1]
	HRRZ	A,JOBREL	;IF JOBDDT=0, JOBFF:=C(JOBREL)-202
	SKIPE	JOBDDT		;OTHERWISE, JOBFF:=C(JOBSYM)-202
	HRRZ	A,JOBSYM
IFN TEMP,<SUBI	A,4>		;SUBTRACT ENOUGH FOR A TMPCOR READ
	MOVEM	A,JOBFF
	SETZM	SFINDF
	MOVSI	A,263000+P*40
	MOVEM	A,TRACS		;TRACS:=POPJ P,
	SETZM	OPNR1		;CLEAR INPUT DEVICE NAME
	MOVEI	A,CBUF+200
	IMULI	A,5
	MOVEM	A,BEG		;BEG:=(CBUF+200)*5
	MOVEM	A,PT		;PT:=(CBUF+200)*5
	MOVEM	A,Z		;Z:=(CBUF+200)*5
	MOVEM	A,QRBUF		;QRBUF:=(CBUF+200)*5
	CALLI	A,GETPPN	;GET USER'S PROJ-PROG #
	MOVEM	A,USRPPN
	SETOM	MONITR		;GET MONITOR SERIES NUMBER
	MOVE	A,[XWD STATES,CNFTBL]
	CALLI	A,GETTAB	;WHICH MONITOR?
	JRST	TECO2		;3 SERIES (MONITR=-1)
	TLNE	A,SERES5
	AOS	MONITR		;5 SERIES (MONITR=+1)
	AOS	MONITR		;4 SERIES (MONITR=0)
TECO2:	CALLI	A,PJOB		;GET JOB #
	MOVEM	A,JOBN
	MOVEI	C,3		;SET CTR
JOBLUP:	IDIVI	A,12		;CONVERT JOB# TO DECIMAL ASCII IN LEFT HALF
	ADDI	AA,20
	LSHC	AA,-6
	SOJG	C,JOBLUP
	HRRI	B,(SIXBIT /TEC/)	;FORM NAME ###TEC
	MOVEM	B,TMPTEC	;SAVE
IFE R,<
	SETZM	QTAB
	MOVE	A,[XWD QTAB,QTAB+1]
	BLT	A,QTABE		;CLEAR THE Q REGS.
>
;COMPUTE A VALUE WHICH IS 2/3 THE SIZE OF THE CHARACTER BUFFER.IF
;1/3 IS LESS THAN 128 CHARACTERS, THE BUFFER WILL BE 2/3 FILLED ON
;A "Y" OR "A" COMMAND,OTHERWISE, THE BUFFER WILL BE FILLED TO THE
;TOTAL AVAILABLE BUFFER - 128 CHARACTERS. PAYING ATTENTION TO THE
;FORM FEED AND LF OPERATORS.

;IT SHOULD BE NOTED THAT IN THE CASE OF AUTOMATIC 
;MEMORY EXPANSION, THESE INSTRUCTIONS MUST BE RE-EXECUTED
;TO INSURE PROPER MEMORY BOUNDS.

	PUSH	P,INITG		;FOR IN LINE CODING POPJ
CRE23:	PUSH	P,FF		;SAVE FLAGS
	MOVE	A,BEG		;GET LATEST BASE VALUE
	MOVEM	A,M23		;BASE VALUE FOR 2/3 FULL
	MOVE	A,JOBFF		;LATEST VALUE OF FF
	IMULI	A,5		;5 CHARACTERS PER MEM WORD
	MOVEM	A,MEMSIZ	;MEMSIZ:=C(JOBFF)*5
	MOVEM	A,M23PL		;TO BECOME THE UPPER LIMIT OF FILL
	SUB	A,BEG		;THIS THE TOTAL BUFFER AVAILABILITY
	IDIVI	A,3		;GET 1/3 LENGTH
	ADDM	A,M23		;FOR YANK AND APPEND SUBROUTINES
	ADDM	A,M23		;WHICH WILL CONDUCT LF SEARCH AFTER 2/3
	MOVNI	FF,^D128	;ANTICIPATE LONG BUFFER
	CAIG	A,^D128		;IS 1/3 GREATER THAN 128 CHARACTERS?
	MOVNI	FF,(A)		;NO,THE REMAINING 1/3 WILL BE STOPPER
	ADDM	FF,M23PL	;SETTLE TOP BOUND OF BUFFER FILL ROUTINE
	POP	P,FF		;RESTORE THE FLAGS
INITG:	POPJ	P,.+1		;EXIT OR CONTINUE
	MOVEI	A,CBUF+77
	MOVEM	A,CBUFH		;CBUFH:=CBUF+77
	MOVEI	A,SYL
	MOVEM	A,DLIM		;DLIM:=SYL
	MOVE	A,[XWD 10014,-1]
	MOVEM	A,NROOM2	;NROOM2:=XWD 10014,-1
	MOVE	A,[JRST CNTRB2]	;CNTRB1+1:=JRST CNTRB2
	MOVEM	A,CNTRB1+1
	MOVEI	FF,0		;CLEAR FLAG REGISTER

GOX:
GO:	MOVE	P,[XWD -LPDL,PDL-1]	;INITIALIZE PUSHDOWN LIST
	MOVE	T,[JRST DQT2]	;INITIALIZE CONTROL B DISPATCH
	MOVEM	T,CNTRB1	;CNTRB1:=JRST DQT2
GO1:	CLEARM	LEV
	MOVE	PF,[XWD -LPF,PFL-1]
	TRZ	FF,777777-TRACEF-QMFLG-FORM
	JRST	CLIS


LOC41:	IFE	R,<JSR UUOH>
	IFN	R,<JSP T,UUOH>
;THIS PAGE CONTAINS THE COMMAND READER FOR THE CCL SYSTEM

IFN CCL,<

;TEMPORARY STORAGE AND LITERAL

TTYPT2:	XWD	260700,TTYBUF	;TO INSERT FILE NAME
				;AFTER EW OR EB

	U	CCLB,3		;THE HEADER FOR CCL FILE IO

CCLIN:
IFN TEMP,<MOVE	A,[XWD 2,TT]	;SET UP FOR TMPCOR READ
	HRRZ	AA,JOBFF	;GET START OF BUFFER AREA
	MOVE	TT,TMPFIL	;SET UP READ BLOCK FOR TMPCOR UUO
	MOVE	TT1,TMPFIL+1	;GET NEGATIVE WORD COUNT
	HRRM	AA,TT1		;TMPFIL+1 = IOWD 200,@JOBFF
	SOS	TT1		;READ BLOCK NOW SET UP IN TT AND TT1
	CALLI	A,TMPCOR	;READ AND DELETE FILE EDT
	JRST	CCLTMP		;NO FILE EDT OR NO TMPCOR UUO
	ADDI	A,(AA)		;GET END OF EDT FILE
	MOVE	T,TTYPT2	;SET UP DDTOUT BUFFER POINTER
	HRLI	AA,350700	;PICK UP EDT CHARACTERS, SKIP "S"
CCLTM1:	ILDB	B,AA		;GET NEXT EDT CHARACTER
	IDPB	B,T		;STORE THIS CHAR IN OUTPUT BUFFER
	PUSHJ	P,DQT3		;IS IT A LETTER OR DIGIT?
	SKIPA			;YES, GO BACK FOR MORE
	JRST	CCLTM2		;NOT A LETTER OR DIGIT OR DOT
	CAILE	A,(AA)		;GONE PAST END OF BUFFER?
	JUMPN	B,CCLTM1	;GET REST OF CHARACTERS
CCLTM2:	TLO	FF,TMPFLG	;SET TMPCOR FLAG
	JRST	CCLIL1		;RETURN TO MAIN FLOW
TMPFIL:	SIXBIT	/EDT/
	XWD	-4,0		;RH FILLED IN ABOVE
CCLTMP:		>
	CALLI	A,30		;GET THE JOB NUMBER
	MOVEI	T,3		;CONVERT TO SIXBIT FILE NAME
JOBL:	IDIVI	A,12		;DECIMAL
	ADDI	AA,20
	LSHC	AA,-6		;TO B
	SOJG	T,JOBL		;THREE DIGITS
	HRRI	B,(SIXBIT /EDT/)	;REST OF NAME
	MOVEM	B,FILNAM
	MOVSI	B,(SIXBIT /TMP/)
	MOVEM	B,FILNAM+1
	MOVE	T,JOBFF		;USE BUFFER SPACE BRIEFLY
	INIT	CCLCHN,0
	SIXBIT	/DSK/		;TO READ THE FILE
	EXP	CCLB		;INPUT BUFFER
	JRST	STARTA		;IF NO DSK, SAY "*"
	INBUF	CCLCHN,1	;DONT ADR CHECK
	LOOKUP	CCLCHN,FILNAM	;OPEN THE FILE
	JRST	STARTA		;IT WASNT THERE?
	INPUT	CCLCHN,0
	MOVEM	T,JOBFF		;GIVE BACK SPACE
	IBP	CCLB+1		;SKIP THE S
	MOVE	T,TTYPT2	;OUTPUT CHARS
CCLIL:	ILDB	B,CCLB+1	;INPUT THE FILE NAME & EXT
	IDPB	B,T		;PUT IT IN THE DDT IN BUFFER
	PUSHJ	P,DQT3		;SEE IF ITS A LTR,DIG OR DOT
	JUMPN	B,CCLIL		;MORE CHARS
CCLIL1:	MOVEI	A,"W"		;PREPARE FOR EW COMMAND
	CAILE	B,15		;WAS BREAK A CRLF?
	JRST	CCLDUN		;NO. ALTMODE ASSUMED
	MOVEI	B,175		;ALTMODES GALORE
	DPB	B,T		;OVERWRITE THE CR
	TLO	FF,CCLFLG	;REQUEST Y AFTER EB
	MOVEI	A,"B"		;NOW PREPARE FOR EB
	IDPB	B,T		;TERMINATING TWO ALT'S
CCLDUN:	IDPB	B,T		;LAST ALT
	MOVEI	B,0		;END OF DDT STRING
	IDPB	B,T
	MOVEI	B,"E"		;NOW FILL IN THE EB OR EW
	MOVE	T,TTYPT		;AT THE BEGINNING OF STRING
	MOVEM	T,TYIPT		;ALSO INITIALIZE TO READ THIS
	IDPB	B,T		;STORE "E"
	IDPB	A,T		;AND EITHER W OR B
	TRO	FF,DDTMF	;FLAG TO GET DDT BUFFER
	SETZM	CCLSW		;DONE WITH THAT MESS
IFN TEMP,<TLZE	FF,TMPFLG	;TMPCOR UUO IN PROGRESS?
	JRST	CCLDU2>		;YES, DONT CLOSE DSK
	CLOSE	CCLCHN,0	;NOW FLUSH FILE
	SETZM	FILNAM		;BY RENAME TO 0
	SETZM	FILNAM+1	;..
	RENAME	CCLCHN,FILNAM	;GO.
	JFCL			;NOGO?
CCLDU2:	RELEAS	CCLCHN,
	POPJ	P,
>
;FROM REE COMMAND DISTRIBUTION IN THE MONITOR
;HERE IS THE ROUTINE FOR RESTORING THE ACCUMULATORS IN CASE OF 
;THE SAVE COMMAND (WHICH DESTROYED THEM) IS COMPLEMENTED BY THE
;GET COMMAND.ALSO TO BE RESTORED IS THE UUO TRAP.

REE:	HRLZI	PF,SAVE		;RESTORE THE AC'S AFTER REE
	BLT	PF,PF		;CAUSE SAVE DESTROYS THEM
	JRST	GO		;GO AND LISTEN FOR INPUT


;ROUTINE TO RETURN NON-NULL TTY CHARACTER IN CH.
;CALL	PUSHJ PDP,TYI 
;	RETURN

TYI:	TLZE	FF,TYOF		;NEED A TYO?
	OUTPUT	TTY,0		;YES. DO SO.
TYI0:	SOSG	TIB+2		;CHARS IN NORMAL MODE?
	JRST	TYI1		;NONE LEFT
TYI2:	ILDB	CH,TIB+1	;YES. GET ONE
	JUMPE	CH,TYI0		;FLUSH NULLS
TYI3:	POPJ	P,		;RETURN.
TYI1:	TRNE	FF,DDTMF	;SHOULD TYI BE DDT STYLE?
	JRST	TYIDDT		;YES
	INPUT	TTY,0		;NO. ORDINARY.
	STATO	TTY,20000	;END OF FILE?
	JRST	TYI2
	PUSHJ	P,TTOPEN	;CLEAR EOF THE HARD WAY
	JRST	TYI0		;^Z WAS SEEN ALREADY. GET ANOTHER CH
TYIDDT:	ILDB	CH,TYIPT	;DDT CHAR LEFT?
	JUMPN	CH,TYI3		;YES. RETURN VIA LC FILTER
	MOVE	T,TTYPT		;NO. GET POINTER
	MOVEM	T,TYIPT		;SET FOR FIRST CH
	CALLI	T,DDTIN		;GET CHARS
	JRST	TYIDDT		;GET THE CHARS FROM BUFFER

TTOPEN:	MOVEI	T,TTYBFS
	EXCH	T,JOBFF		;SET JOBFF AND SAVE IT
	INIT	TTY,100		;INIT THE CONSOLE
	SIXBIT	/TTY/
	XWD	TOB,TIB		;SHOULD BE 
	JRST	.-3		;I REALLY WANT TTY
	INBUF	TTY,1
	OUTBUF	TTY,1		;KEEP IT SMALL
	MOVEM	T,JOBFF		;RESTORE JOBFF
	SETZM	TYIPT		;SIGNAL DDT BUFFER EMPTY
	POPJ	P,
;ROUTINE TO TYPE A CHARACTER.
;CALL	MOVE CH,CHARACTER
;	PUSHJ P,TYO
;	RETURN
;UNLESS TYOCTF IS TRUE,
;CONTROL CHARACTERS ARE TYPED WITH "^" FOLLOWED BY THE CORRESPONDING
;PRINTING CHARACTER.

TYO:	PUSH	P,CH		;NULL/IDLE,START OF MESSAGE,END OF ADDRESS, END OF
				;TRANSMISSION,WRU,ARE YOU OR BELL?
	TLNE	FF,TYOCTF	;ET IN EFFECT?
	JUMPN	CH,TYOB		;YES, TYPE CONTROL CHARS.
	CAIGE	CH,7
	JRST	TYO1		;YES.
	CAIG	CH,15		;NO. HORIZONTAL TAB,LINE FEED,VERTICAL TAB
				;FORM FEED OR CARRIAGE RETURN?
	JRST	TYOB		;YES. TYPE IT AND RETURN
	CAIGE	CH,40		;NO. ANY OTHER CONTROL CHARACTER?
	JRST	TYO1		;YES.
	CAIN	CH,175		;NO. ALT-MODE?
	MOVEI	CH,"$"		;YES. CONVERT IT TO $.
TYOB:	PUSHJ	P,TYOA		;TYPE CH.
	POP	P,CH		;RESTORE CH
	POPJ	P,		;RETURN

TYOA:	TLO	FF,TYOF		;MARK WILL NEED TO OUTPUT
	SOSG	TOB+2		;OUTPUT SPACE AVAIL?
	OUTPUT	TTY,0		;NO. OUTPUT.
	IDPB	CH,TOB+1
	CAILE	CH,14		;FORCE OUTPUT ON LF,FF ETC
	POPJ	P,		;NO
	OUTPUT	TTY,0
	TLZ	FF,TYOF		;NO LONGER NEED TO OUTPUT
	POPJ	P,

TYO1:	PUSH	P,CH		;TYPE CONTROL CHARACTER IN FORM "^CH"
	MOVEI	CH, "^"
	PUSHJ	P,TYOA		;TYPE ^
	POP	P,CH
	ADDI	CH,100		;CONVERT TO PRINTING CHARACTER
	JRST	TYOB		;AND TYPE IT.

TTYPT:	XWD	440700,TTYBUF

U TYIPT,1			;
U TTYBFS,46			;100 MODE TTY BFRS
U TIB,3				;BUFFER HEADER
U TOB,3				;DITTO
U TTYBUF,22			;
U JOBN,1			;JOB #
U USRPPN,1			;USER PRPJ-PROG #
U MONITR,1			;MONITOR LEVEL: 0=3,1=4,2=5
;ROUTINE TO TYPE "? ERROR MESSAGE"
;CALL	JSP A,ERRMES
;	ASCIZ /ERROR MESSAGE/
;	RETURN


ERRMES:	MOVEI	CH,"?"
	PUSHJ	P,TYO

;ROUTINE TO TYPE "MESSAGE"
;CALL JSP A,CONMES
;	ASCIZ /MESSAGE/
;	RETURN

CONMES:	HRLI	A,440700
	ILDB	CH,A
	JUMPE	CH,1(A)
	PUSHJ	P,TYO
	JRST	.-3


;ROUTINE TO TYPE C(A) IN SIXBIT
;CALL	MOVE A,[SIXBIT /MESSAGE/]
;	PUSHJ P,SIXBMS
;	RETURN


SIXBMS:	MOVNI	B,6
	MOVE	E,[XWD 440600,A]
	ILDB	CH,E
	JUMPE	CH,CPOPJ
	ADDI	CH,40
	PUSHJ	P,TYO
	AOJL	B,.-4
	POPJ	P,

U IBUF,3			;
U OBF,3				;
U IBUF1,2*BUFSIZ		;
U OBUF1,2*BUFSIZ		;
;ROUTINE TO OUTPUT DECIMAL INTEGER
;CALL	MOVE B, DECIMAL INTEGER
;	MOVEI A,ADDRESS OF OUTPUT ROUTINE
;	HRRM A,LISTF5
;	PUSHJ P,DPT
;	RETURN

DPT:	JUMPGE	B,.+3		;NUMBER > 0?
	MOVEI	CH,"-"		;NO. OUTPUT -
	PUSHJ	P,@LISTF5
	MOVMS	B		;B:=ABSOLUTE VALUE OF B
	IDIVI	B,12		;E:=DIGIT
	HRLM	E,(P)		;PUT DIGIT ON LEFT HALF OF TOP OF PUSH DOWN LIST
	JUMPE	B,.+2		;DONE?
	PUSHJ	P,.-3		;NO. PUSH THIS DIGIT AND PRINT RETURN ADDRESS.
	HLRZ	CH,(P)		;YES. CH:=DIGIT
	ADDI	CH,60		;CONVERT IT TO ASCII.
	JRST	@LISTF5		;PRINT IT



;ROUTINE TO TYPE CARRIAGE RETURN LINE FEED
;CALL	PUSHJ P,CRR
;	RETURN
CRR:	MOVEI	CH,TYO		;SET OUTPUT DISPATCH TO TTY AND
	HRRM	CH,LISTF5

CRR1:	MOVEI	CH,15		;OUTPUT CRLF
	PUSHJ	P,@LISTF5
	MOVEI	CH,12
	JRST	@LISTF5
;ROUTINE TO RETURN NEXT CHARACTER FROM COMMAND BUFFER AND ERROR IF EMPTY.
;CALL	PUSHJ P,SKRCH
;	RETURN WITH CHARACTER IN CH
;GOES TO ERR IF COMMAND BUFFER IS EMPTY

SKRCH:	SKIPN	COMCNT		;COMMAND BUFFER EMPTY?
	ERROR	^D1
				;YES. SKRCH SHOULDN'T RUN OUT.

;ROUTINE TO RETURN NEXT CHARACTER FROM COMMAND BUFFER.
;CALL	PUSHJ P,RCH
;	RETURN ALWAYS WITH CHARACTER IN CH

RCH:	SOSGE	COMCNT		;DECREMENT COMMAND BUFFER CHARACTER COUNT
				;IS COMMAND BUFFER EMPTY?
	JRST	RCH2		;YES. POP UP TO HIGHER MACRO LEVEL.
	ILDB	CH,CPTR		;NO. GET COMMAND CHARACTER IN CH
	XCT	TRACS		;RETURN OR JRST TYO IN TRACE MODE
RCH2:	POP	P,CH		;SAVE RETURN FOR POPJ IN CH
	POP	P,COMCNT	;GET COUNT FROM NEXT MACRO LEVEL
	POP	P,CPTR		;POINTER TOO.
	POP	P,COMAX		;NUMBER OF COMMANDS.
	PUSH	P,CH		;GET RETURN BACK ON PDL.
	TRZ	FF,ALTF		;CLR IN CASE LAST CHAR IN MACRO WAS ALTMOD
	JRST	RCH		;TRY AGAIN.

U TRACS,1			;

SKRCH1:	SOSGE	COMCNT		;ANY CHARACTERS LEFT?
	ERROR	^D1
				;NO. SUPPOSEDLY CAN'T RUN OUT OF
				;COMMANDS AT THIS ROUTINE.
	ILDB	CH,CPTR		;YES. GET A CHARACTER.
	POPJ	P,		;RETURN.
CLIS:	PUSHJ	P,TTOPEN	;GET TELETYPE
LIS:	MOVEI	CH,"*"
IFN CCL,<SKIPN	CCLSW		;NEED CCL COMMAND?
	JRST	LIS0		;NO
	PUSHJ	P,CCLIN		;GET THE CCL COMMAND TO TYI BUFFER
	JRST	LIS02		;AND DONT SAY STAR
>
LIS0:	PUSHJ	P,TYO		;TYPE *
LIS02:	TRNE	FF,QMFLG
	TRO	FF,DDTMF	;NEED DDT MODE FOR "?"
	CLEARM	COMCNT		;COMCNT:=0
	CLEARM	INTDPH		;INTDPH:=0
	CLEARM	ITERCT
	CLEARM	SYMS
	MOVE	T,[XWD SYMS,SYMS+1]
	BLT	T,SYMEND-1
	MOVE	AA,[XWD 700,CBUF-1]
	MOVE	B,CBUFH

LI1:	TRZ	FF,ALTF+BELLF
IFE R,<	CAML	B,JOBREL	;NEEDED TO FORCE GRABBING MORE CORE
	JRST	LI6>		;WHERE 1ST COMMAND LINE OVERFLOWS CORE

LI2:	CAILE	B,(AA)		;COMMAND BUFFER EXCEEDED?
	JRST	LI3		;NO


;TO SEE IF TECO WILL NEED MORE CORE FOR COMMAND 
;BUFFER EXPANSION. IF SO, GET IT

LI6:	MOVE	C,Z		;GET THE NUMBER OF CHARACTERS NOW
	ADDI	C,500		;WILL WE OVERFLOW IF THIS IS REQUESTED?
	CAMG	C,MEMSIZ	;WILL THIS OVERFLOW?
	JRST	.+5		;NO, FORGET THIS EVER HAPPENED
	PUSH	P,17		;WILL OVERFLOW, THEREFORE, SAVE AC#17
	MOVE	17,C		;THIS IS THE REQUEST FOR MEMORY
	PUSHJ	P,GRABKQ	;GET THE NECESSARY CORE
	POP	P,17		;RESTORE AC#17
;OK, EXPAND THE COMMAND BUFFER CONFIDENTLY

	ADDI	B,100		;YES. EXPAND COMMAND BUFFER 100 WORDS.
	MOVE	C,Z
	IDIVI	C,5		;C:=DATA BUFFER END WORD ADDRESS.
	MOVE	D,QRBUF
	IDIVI	D,5		;D:=Q-REG BUFFER BASE WORD ADDRESS.
	SUBM	C,D		;D:=NO. OF WORDS IN Q-REG BUFFER AND DATA BUFFER.
	MOVE	CH,(C)
	MOVEM	CH,100(C)	;MOVE Q-REG AND DATA BUFFERS UP 100 WORDS.
	SOS	C
	SOJGE	D,.-3
	MOVEI	C,500
	ADDM	C,BEG		;BEG:=C(BEG)+500
	ADDM	C,PT		;PT:=C(PT)+500
	ADDM	C,Z		;Z:=C(Z)+500
	ADDM	C,QRBUF		;QRBUF:=C(QRBUF)+500
	MOVE	D,Z
LI3:	MOVEM	B,CBUFH		;NO. RESET HIGH END OF COMMAND BUFFER.
	PUSHJ	P,TYI		;GET A NON-NULL CHARACTER IN CH
	CAIE	CH,33		;IS IT AN OLD ALT-MODE CODE?
	CAIN	CH,176
	MOVEI	CH,175		;YES. CONVERT TO NEW ALT-MODE CODE.
	TRZE	FF,QMFLG	;CLEAR ? FLAG. WAS IT ON?
	CAIE	CH,"?"		;YES. IS THIS A "?"?
	AOSA	COMCNT		;NO. INCREMENT COMMAND CHARACTER COUNT
	JRST	ERRTYP		;YES. TYPE BAD STRING
	IDPB	CH,AA		;NO. STORE CHARACTER IN COMMAND BUFFER.
	CAIE	CH,177		;IS IT A RUBOUT?
	JRST	LI4		;NO.

;DELETE A CHARACTER FROM THE COMMAND BUFFER.
	IBP	AA		;YES. BACKUP BYTE POINTER TWO BYTES
	IBP	AA
	IBP	AA
	SOS	D,AA
	CAMN	AA,[XWD 100700,CBUF-1]	;DID IT GO PAST THE BEGINNING
				;OF THE BUFFER
	JRST	CLIS1		;YES. TYPE CRLF *
	ILDB	CH,D		;NO. TYPE DELETED CHARACTER
	PUSHJ	P,TYO
	SOS	COMCNT		;REMOVE TWO CHARACTERS FROM COMMAND COUNT.
	SOS	COMCNT
	JRST	LI1		;AND GET ANOTHER COMMAND CHARACTER
LI4:	CAIE	CH,175		;ALT-MODE?
	JRST	LI5		;NO
	TRON	FF,ALTF		;YES. SET ALT-MODE FLAG. WAS IT ON?
	JRST	LI2		;NO
	MOVEI	CH,141		;YES. TWO SUCCESSIVE ALT-MODES. END OF COMMAND.
	AOS	A,COMCNT	;MARK END OF COMMAND STRING WITH ASCII 141
	IDPB	CH,AA
	MOVE	AA,[XWD 700,CBUF-1]	;INITIALIZE COMMAND BYTE POINTER
	MOVEM	AA,CPTR
	PUSHJ	P,CRR		;TYPE CRLF
	MOVEM	A,COMAX		;SET COMMAND CHARACTER ADDRESS UPPER BOUND
	JRST	CD		;DECODE COMMAND

CLIS1:	PUSHJ	P,CRR		;TYPE CRLF
	JRST	CLIS		;AND GO TYPE *.

LI5:	CAIE	CH,7		;BELL?
	JRST	LI1		;NO. GET MORE CHARACTERS.
	TRON	FF,BELLF	;YES. SET BELL FLAG. TWO SUCCESSIVE BELLS?
	JRST	LI2		;NO.
	PUSHJ	P,CRR		;YES. TYPE A CRLF
	JRST	GOX		;AND CLEAR COMMAND BUFFER.
CD:
RET:	TRZ	FF,ARG2+ARG+FINDR+PCHFLG
	TLZ	FF,UEBTMP
	MOVEM	PF,SAV17	;TO SAVE AC'S IN CASE OF A 
	MOVEI	PF,SAVE		;SNEEK SAVE
	BLT	PF,SAV16	;WHICH WILL DESTROY THEM
	MOVE	PF,JOBFF	;GET CONTENTS OF FIRST FREE
	HRLM	PF,JOBSA	;FOR JOBSA. MONITOR OR LOADER SHOULD DO THIS
				;BUT UNTILL IT DOES, THIS IS NEC
				;ESSARY FOR THE SAVE TO WORK
	MOVE	PF,SAV17	;RESTORE THE AC#17, GO TO WORK
CD1:	CLEARM	NUM

;ADD TAKES ONE OR TWO ARGUMENTS

CD2:	MOVSI	A,270000+B*40	;DELIM:=ADD B,
CD3:	HLLM	A,DLIM
CD4:	CLEARM	SYL
CD5:	PUSHJ	P,RCH
CD9:	MOVE	A,CH		;GET COMMAND CHARACTER
	CAILE	A,174		;IF 175,176,177 ADD 3
	ADDI	A,3
	CAILE	A,137		;REDUCE LOWER CASE TO UPPER
	SUBI	A,40
	ROT	A,-1		;DIV BY 2
	JUMPL	A,CD92		;ODD CHARACTER
	HLRZ	A,DTB(A)	;GET CODE & ADDR FOR EVEN CHAR.
	JRST	CD93
CD92:	HRRZ	A,DTB(A)	;GET CODE & ADDR FOR ODD CHAR.
CD93:	HRLI	A,(JRST)	;ASSUME IT'S A JRST X
	TRNN	A,300000	;IS IT?
	XCT	A		;YES, DO IT
	HRLI	A,(MOVEI A,)	;NO, MAYBE IT'S A MOVEI A,X
	TRZN	A,200000	;IS IT?
	HRLI	A,(HRROI A,)	;NO, IT'S A HRROI A,X
	TRZ	A,100000	;CLR HRROI BIT
	XCT	A		;DO THE MOVEI OR HRROI
CD6:	MOVE	B,NUM
	TRZE	FF,SYLF		;DID LAST CHARACTER RETURN A VALUE OR WAS IT A DIGIT?
	XCT	DLIM		;YES. NUM:=NUM (DLIM OPERATOR) SYL
	MOVEM	B,NUM
	MOVE	C,SARG		;SAVE SECOND ARGUMENT IN C.
	TRZ	FF,NOTF
	JUMPGE	A,(A)		;DISPATCH IF VALUE RETURN COMMAND.
	PUSHJ	P,(A)		;DISPATCH FOR NON-VALUE RETURN COMMANDS.
	JRST	RET


U DLIM,1			;
U NUM,1				;
U SYL,1				;
U SARG,1			;
;DIGITS FORM DECIMAL INTEGERS.

CDNUM:	MOVE	A,SYL
	IMULI	A,12
	ADDI	A,-60(CH)

;SOME COMMANDS HAVE A NUMERIC VALUE
VALRET:	MOVEM	A,SYL
CD7:	TRO	FF,ARG+SYLF
	JRST	CD5
ALTMOD:	MOVE	T,CPTR		;IF NEXT COMMAND CHARACTER IS ALT-MODE,
				;OR END OF COMMAND BUFFER, GO;ELSE CD.
	ILDB	CH,T
	CAIE	CH,175
	CAIN	CH,141
	JRST	GO
	JRST	CD

;^ MEANS THAT THE NEXT CHARACTER IS A CONTROL CHARACTER.

UAR:	PUSHJ	P,SKRCH		;GET NEXT COMMAND CHARACTER.
	TRZ	CH,140		;CHANGE IT TO CONTROL CHARACTER
	JRST	CD9		;DISPATCH


;FINISH OUTPUT AND RETURN TO THE TIME-SHARING EXEC.

DECDMP:	TLZ	FF,UREAD+UWRITE+FINF+UBAK	;IN CASE SOMEONE REENTERS
	MOVE	A,SAVE
	TLZ	A,UREAD+UWRITE+FINF+UBAK
	MOVEM	A,SAVE
	CALLI	EXIT
;IF A COMMAND TAKES TWO NUMERIC ARGUMENTS, COMMA IS USED TO SEPARATE THEM

COMMA:	MOVEM	B,SARG		;SAVE CURRENT ARGUMENT IN SARG.
	TRZE	FF,ARG		;WAS THERE A CURRENT ARGUMENT?
	TROE	FF,ARG2		;YES. WAS THERE ALREADY A SECOND ARGUMENT?
	ERROR	^D3
				;NO. EITHER NO ARGUMENT OR MORE THAN TWO ARGUMENTS.
	JRST	CD1		;YES. CLEAR CURRENT ARGUMENT.

;LOGICAL AND

CAND:	MOVSI	A,404000+B*40	;DLIM:=AND B,
	JRST	CD3

;LOGICAL OR

COR:	MOVSI	A,434000+B*40	;DLIM:=OR B,
	JRST	CD3

;SUBTRACT TAKES ONE OR TWO ARGUMENTS

MINUS:	MOVSI	A,274000+B*40	;DLIM:=SUB B,
	JRST	CD3

;MULTIPLY TAKES TWO ARGUMENTS

TIMES:	MOVSI	A,220000+B*40	;DLIM:=IMUL B,
	JRST	CD3

;DIVIDE (TRUNCATES) TAKES TWO ARGUMENTS

SLASH:	MOVSI	A,230000+B*40	;DLIM:=IDIV B,
	JRST	CD3


;RETURNS THE VALUE OF THE FORM FEED FLAG

FFEED:	TRNE	FF,FORM		;IS IT SET?
	JRST	FFOK		;YES, RETURN A -1
				;NO, DO BEGIN ROUTINE
;RETURNS THE NUMERIC VALUE 0.

BEGIN:	MOVEI	A,0
	JRST	VALRET
;AN ABBREVIATION FOR B,Z

HOLE:	CLEARM	SARG		;SET SECOND ARGUMENT TO 0.
	TRZN	FF,ARG		;ANY ARGS BEFORE H?
	TRNE	FF,ARG2		; ..
	ERROR	^D3		;THATS TOO BAD
	TROA	FF,ARG2

;.=NUMBER OF CHARACTERS TO THE LEFT OF THE POINTER

PNT:	SKIPA	A,PT

;Z=NUMBER OF CHARACTERS IN THE BUFFER

END1:	MOVE	A,Z
	SUB	A,BEG
	JRST	VALRET

;() MAY BE USED TO OVERRIDE LEFT TO RIGHT OPERATOR SCAN FOR +,-,*,/,& AND #.

OPEN:	PUSH	P,NUM		;PUSH CURRENT ARGUMENT.
	HLLZ	A,DLIM		;GET CURRENT OPERATOR.
	TRZE	FF,ITERF	;ARE WE INSIDE AN ITERATION?
	IORI	A,1		;YES. MARK OPERATOR AS BEING WITHIN AN ITERATION.
	PUSH	P,A		;PUSH CURRENT OPERATOR.
	AOS	LEV		;INCREMENT ( LEVEL.
	JRST	RET

CLOSE:	SOSGE	LEV		;IS THERE A (?
	ERROR	^D4
				;NO.
	MOVEM	B,SYL		;YES. SAVE CURRENT ARGUMENT.
	POP	P,CH		;RESTORE OPERATOR.
	HLLM	CH,DLIM
	TRZ	FF,ITERF
	TRNE	CH,1
	TRO	FF,ITERF	;RESTORE ITERATION FLAG FOR THIS OPERATOR.
	POP	P,NUM		;RESTORE ARGUMENT.
	JRST	CD7

U LEV,1				;
;N=	CAUSES THE VALUE OF N TO BE TYPED OUT.

PRNT:	TRNN	FF,ARG		;HERE ON "=" COMMAND
	ERROR	^D5		;MUST HAVE ARG
PRNT9:	MOVEI	A,TYO
	HRRM	A,LISTF5	;CONSOLE
	PUSHJ	P,DPT
	JRST	CRR		;CRLF AND RETURN TO CALLER



;CAUSES COMMAND INTERPRETATION TO STOP UNTIL THE USER TYPES A CHARACTER
;ON THE TELETYPE AND THEN HAS THE ASCII VALUE OF THE CHARACTER TYPED IN.


SPTYI:	TRO	FF,DDTMF	;NEED DDT MODE FOR THIS
	PUSHJ	P,TYI
	SKIPA	A,CH


;HAS THE VALUE OF ELAPSED TIME, IN 60THS OF A SECOND, SINCE MIDNITE.

GTIME:	CALLI	A,TIMER
	JRST	VALRET


;HAS THE VALUE OF THE CONSOLE DATA SWITCHES.

LAT:	CALLI	A,SWITCH
	JRST	VALRET



;HAS THE VALUE OF THE NEXT CHARACTER IN THE COMMAND STRING.

CNTRUP:	PUSHJ	P,RCH		;^^ HAS VALUE OF CHAR FOLLOWING IT
	MOVE	A,CH
	JRST	VALRET
;HAS THE VALUE OF THE NUMBER REPRESENTED BY THE DIGITS (OR MINUS SIGN)
;FOLLOWING THE POINTER IN THE BUFFER.  THE SCAN TERMINATES ON ANY OTHER
;CHARACTER.  THE POINTER IS MOVED OVER THE NUMBER FOUND (IF ANY).

BAKSL:	TRZE	FF,ARG		;WHICH KIND OF BACKSLASH?
	JRST	BAKSL1		;ARG TO MEMORY
	MOVE	I,PT		;MEMORY TO VALRET
	CAML	I,Z		;CAN WE READ ANOTHER?
	JRST	BAKSL3		;NO
	PUSHJ	P,GETINC	;CK FOR +,- SIGN
	CAIN	CH,"+"
	JRST	BAKSLA		;IGNORE +
	CAIE	CH,"-"
	JRST	BAKSL0		;NO SIGN
	TRO	FF,ARG		;NEGATION FLAG
BAKSLA:	CAML	I,Z		;OVERDID IT ?
	JRST	BAKSL3		;YES. EXIT
	PUSHJ	P,GETINC	;NO. GET A CHAR
BAKSL0:	CAIG	CH,"9"		;DIGIT?
	CAIGE	CH,"0"		;DIGIT?
	SOJA	I,BAKSL2	;NOT A DIGIT. BACKUP AND LEAVE LOOP
	SUBI	CH,"0"		;CONVERT TO NUMBER
	EXCH	CH,SYL
	IMULI	CH,12
	ADDM	CH,SYL		;SYL:= 10.*SYL+CH
	JRST	BAKSLA		;LOOP

BAKSL3:	MOVE	I,Z		;HERE ON OVERFLOW
BAKSL2:	TRZE	FF,ARG		;MINUS SIGN SEEN?
	MOVNS	SYL		;YES. NEGATE
	MOVEM	I,PT		;MOVE POINTER PAST #
	JRST	CD7		;DONE

BAKSLM:	TRO	FF,ARG
	JRST	BAKSLA


;NA (WHERE N IS A NUMERIC ARGUMENT) = VALUE IN 7-BIT ASCII OF THE
;CHARACTER TO THE RIGHT OF THE POINTER.

ACMD:	TRNN	FF,ARG		;DOES AN ARGUMENT PRECEED A?
	JRST	APPEND		;NO. THIS IN AN APPEND COMMAND.
	MOVE	A,Z		;IF POINTER IS AT END OF
	SUB	A,PT		; BUFFER OR IF BUFFER EMPTY,
	JUMPE	A,VALRET	; MUST GIVE 1A=0
	MOVE	I,PT		;YES.
	PUSHJ	P,GET		;CH:=CHARACTER TO THE RIGHT OF PT.
	MOVE	A,CH		;RETURN CH AS VALUE.
	JRST	VALRET
;NUI	PUTS THE NUMERIC VALUE N IN Q-REGISTER I.

USE:	TRNN	FF,ARG		;DID AN ARGUMENT PRECEED U?
	ERROR	^D6		;NO.


USEA:	PUSHJ	P,QREGVI	;YES. CH:=Q-REGISTER INDEX.
	MOVEM	B,QTAB-"0"(CH)	;STORE ARGUMENT IN SELECTED Q-REG.
	JRST	RET

;QI	HAS THE VALUE OF THE LATEST QUANTITY PUT INTO Q-REGISTER I.

QREG:	PUSH	P,USE1		;SET RETURN ADDRESS TO VALRET AND FALL INTO QREGVI.

;ROUTINE TO RETURN Q-REGISTER INDEX IN CH AND CONTENT IN A.
;CALL	PUSHJ P,QREGVI
;	RETURN
;ASSUMES COMCNT,CPTR AND COMAX ARE SET UP.
;IF NEXT CHARACTER IN COMMAND STRING IS NOT A LETTER OR A DIGIT, DOES NOT RETURN.
;FROM USEA,PCNT,OPENB+1,MAC,QGET

QREGVI:	PUSHJ	P,RCH		;CH:=NEXT COMMAND STRING CHARACTER.
	CAIL	CH,140		;LC LETTER?
	TRZ	CH,40		;MAKE UC
	CAIL	CH,"0"		;LETTER OR DIGIT?
	CAILE	CH,"Z"
	ERROR	^D7		;NO
	CAIL	CH,1+"9"	;YES. DIGIT?
	SUBI	CH,"A"-"9"-1	;NO. TRANSLATE LETTERS DOWN BY NUMBER OF
				;CHARACTERS BETWEEN 9 AND A. ONLY 36 Q REG'S
	MOVE	A,QTAB-"0"(CH)	;A:=CONTENTS OF Q-REGISTER.
USE1:	POPJ	P,VALRET


;%I	ADDS 1 TO THE QUANTITY IN Q-REGISTER I AND STANDS FOR THE
;	NEW VALUE

PCNT:	PUSHJ	P,QREGVI	;CH:=Q-REGISTER INDEX.
	AOS	A,QTAB-"0"(CH)	;INCREMENT Q-REG.
	JRST	VALRET		;RETURN NEW VALUE.
;M,NXI	COPIES A PORTION OF THE BUFFER INTO Q-REGISTER I.
;	IT SETS Q-REGISTER I TO A DUPLICATE OF THE (M+1)TH
;	THROUGH NTH CHARACTERS IN THE BUFFER.  THE BUFFER IS UNCHANGED.
;NXI	INTO Q-REGISTER I IS COPIED THE STRING OF CHARACTERS STARTING
;	IMMEDIATELY TO THE RIGHT OF THE POINTER AND PROCEEDING THROUGH
;	THE NTH LINE FEED.

X:	PUSHJ	P,GETARG	;C:=FIRST STRING ARGUMENT ADDRESS
				;B:=SECOND STRING ARGUMENT ADDRESS.
	PUSHJ	P,CHK1		;IS SECOND ARG. ADDR. > FIRST ARG. ADDR.?
	EXCH	B,C		;YES.
	SUBI	C,-3(B)		;C:=LENGTH OF STRING+3.
	ADD	B,C		;B:=FIRST ARG ADDR + LENGTH OF STRING + 3
	PUSH	P,PT
	ADDM	C,(P)		;(P):=PT + LENGTH OF STRING + 3.
	MOVE	D,BEG
	MOVEM	D,PT		;PT:=BEG
	PUSHJ	P,NROOM		;INSERT STRING AT BEG
	MOVE	OU,RREL		;RREL CONTAINS RELOCATION CONSTANT IF
				;GARBAGE COL. OCCURRED.
	ADDM	OU,(P)		;RELOCATE TOP OF STRING POINTER.
	ADD	B,OU		;B:=FIRST ARG ADDR + LENGTH OF STRING + 3 + RREL
	MOVE	OU,BEG		;OU:=ADDRESS OF Q-REG BUFFER
	ADDM	C,BEG		;BEG:=C(BEG)+LENGTH OF STRING + 3
	MOVE	CH,C		;FIRST CHAR OF BUFFER :=LEAST SIGNIFICANT 7 BITS
	PUSHJ	P,PUT		;OF LENGTH OF STRING + 3
	AOS	OU		;SECOND CHAR = MIDDLE 7 BITS OF LENGTH
	ROT	CH,-7
	PUSHJ	P,PUT
	ROT	CH,-7
	MOVE	I,B		;THIRD CHAR OF BUFFER := MOST SIGNIFICANT 7 BITS
				;OF LENGTH OF STRING + 3
	AOS	OU
X1:	PUSHJ	P,PUT		;MOVE STRING TO Q-REG BUFFER.
	AOS	OU
	CAIN	C,3
	JRST	X2
	PUSHJ	P,GETINC
	SOJA	C,X1
X2:	MOVE	B,PT		;QTAB ENTRY :=XWD 400000,Q-REG BUFFER
				;ADDRESS RELATIVE TO C(QRBUF)
	SUB	B,QRBUF
	TLO	B,400000
	POP	P,PT		;MOVE PT PAST STRING.
	JRST	USEA		;MAKE QTAB ENTRY.
;GI	THE TEXT IN Q-REGISTER I IS INSERTED INTO THE BUFFER AT THE
;	CURRENT LOCATION OF THE POINTER.  THE POINTER IS THEN PUT JUST
;	TO THE RIGHT OF THE INSERTION.  THE Q-REGISTER IS NOT CHANGED.

QGET:	PUSHJ	P,QTEXT		;INIT Q-REG ACCESS
	MOVE	B,CH		;SAVE INDEX
	PUSHJ	P,GTQCNT	;C:=LENGTH OF STRING
	PUSHJ	P,NROOM		;MOVE FROM PT THROUGH Z UP C POSITIONS
	MOVE	OU,PT
	HRRZ	I,QTAB-"0"(B)
	ADD	I,QRBUF
	ADDI	I,3
QGET1:	JUMPE	C,RET		;MOVE STRING INTO DATA BUFFER
	PUSHJ	P,GETINC
	PUSHJ	P,PUT
	AOS	OU,PT
	SOJA	C,QGET1

;GET 21 BIT Q-REGISTER CHARACTER COUNT

GTQCNT:	PUSHJ	P,GETINC	;LOW ORDER 7 BITS
	MOVEM	CH,C
	PUSHJ	P,GETINC	;MIDDLE 7 BITS
	ROT	CH,7
	IORM	CH,C
	PUSHJ	P,GETINC	;HIGH 7 BITS
	ROT	CH,^D14
	IORM	CH,C
	SUBI	C,3		;LESS 3 WORDS USED TO STORE THIS COUNT
	POPJ	P,

;INITIALIZE ACCESS OF TEXT FROM A Q-REGISTER

QTEXT:	PUSHJ	P,QREGVI	;A=QTAB ENTRY, CH=Q-REG INDEX
	TLZE	A,400000	;MAKE SURE IT CONTAINS TEXT
	TLZE	A,377777
	ERROR	^D36		;IT DOESN'T
	ADD	A,QRBUF
	MOVE	I,A		;IN=Q-REG BUFFER ADDRESS
	POPJ	P,
;MI	PERFORM NOW THE TEXT IN Q-REGISTER I AS A SERIES OF COMMANDS.

MAC:	PUSHJ	P,QTEXT		;INIT Q-REG ACCESS
	PUSH	P,COMAX		;SAVE CURRENT COMMAND STATE
	PUSH	P,CPTR
	PUSH	P,COMCNT
	PUSHJ	P,GTQCNT	;GET NUMBER OF CHARACTERS IN MACRO
	MOVEM	C,COMCNT	;THAT MANY COMMANDS TO COUNT
	MOVEM	C,COMAX		;AND MAX.
	SUBI	I,1		;ADJUST TO SUIT BTAB
	IDIVI	I,5
	MOVE	OU,BTAB(OU)	;MAKE A BYTE POINTER
	HRR	OU,I
	MOVEM	OU,CPTR		;PUT IT IN CPTR
	JRST	CD5		;DON'T FLUSH ANY ARGUMENTS


;]I	POPS Q-REGISTER I OFF THE Q-REGISTER PUSHDOWN LIST.
;	THE Q-REGISTER PUSHDOWN LIST IS CLEARED EACH TIME $$ IS TYPED.

CLOSEB:	SKIPA	C,[POP PF,]

;[I	PUSHES Q-REGISTER I ONTO THE Q-REGISTER PUSHDOWN LIST.

OPENB:	MOVSI	C,261000+PF*40
	PUSHJ	P,QREGVI
	HRRI	C,QTAB-"0"(CH)	;C:=Q-REGISTER INDEX.
	XCT	C		;PUSH OR POP Q-REGISTER.
	TRNE	FF,ARG		;IS THERE AN ARGUMENT?
	JRST	CD2		;YES. DON'T DESTROY IT.
	JRST	RET		;NO. CLEAR FLAGS.
;E COMMANDS SELECT AND CONTROL FILE INPUT-OUTPUT MEDIA

ECMD:	PUSHJ	P,RCH
	TRZ	CH,40		;LC TO UC
	CAIN	CH,"T"		;ET?
	JRST	TYOCTL		;YES, CONTROL CHAR MODE.
	CAIN	CH,"R"		;NO. ER?
	JRST	OPNRD		;YES. NEW INPUT FILE.
	CAIN	CH,"W"		;NO. EW?
	JRST	OPNWR		;YES. NEW OUTPUT FILE.
	CAIN	CH,"F"		;NO. EF?
	JRST	CLOSEF		;YES. CLOSE OUTPUT FILE.
	CAIN	CH,"Z"		;NO. EZ?
	JRST	ZERDIR		;YES. CLEAR DIRECTORY.
	CAIN	CH,"M"		;NO. EM?
	JRST	EMTAPE		;YES. EXECUTE MTAPE UUO.
	CAIN	CH,"B"		;NO. EB?
	JRST	EBAKUP		;YES. BACKUP SYSTEM
	CAIN	CH,"X"		;EX?
	JRST	FINISH		;YES. DO 69000PEF<DING>
IFN CCL,<
	CAIN	CH,"G"
	JRST	CCLFIN		;EX AND THEN RUN COMPIL
>
	ERROR	^D11		;NO. COMMAND ERROR.

U FILPPN,1	;FILE PROJ-PROG AREA
U FILDEV,1	;FILSPC+1(0),FILSP1+1	
U FILNAM,4	;NAME IN SIXBIT.  FILSPC+2(0),FILLS1+5
		;(EXT)BLK #.  FILSPC+3(0),FILLS1+2
		;PROT,DATE.  FILSPC+4(0)
		;(PROJ)PROG.  FILSPC+5(0),FILSPS,FILSP6
U BAKNAM,2	;FOR THE BACKUP NAME
FINIS1:	TRO	FF,PCHFLG	;NO FREE FORM FEEDS
	TRNE	FF,ARG+ARG2	;ARGUMENT?
	ERROR	^D46		;SHOULDNT BE.
	MOVSI	B,1		;A LARGE NUMBER OF PAGES
	PUSHJ	P,PUNCH		;PUNCH THOSE PAGES
	JRST	CLOSEF		;CLOSE AND RENAME FILES
				;RETURN FROM FINIS1

FINISH:	PUSHJ	P,FINIS1	;FINISH UP.
	JRST	DECDMP		;AND CALL EXIT

IFN CCL,<
CCLFIN:	PUSHJ	P,FINIS1	;FINISH FILE IO
	SKIPGE	MONITR		;CHECK FOR 4 SERIES MONITOR
	JRST	NORUN		;3 SERIES - SIMULATE RUN UUO
	MOVEI	A,CCLBLK	;RUN COMPIL
	HRLI	A,1		;AT START ADR PLUS ONE
	CALLI	A,35		;RUN UUO
	JRST	DECDMP		;JUST EXIT IF NO RUN.

CCLBLK:	SIXBIT	/SYS/
	SIXBIT	/COMPIL/	;RUN SYS:COMPIL
	REPEAT	4,<0>
>
IFN CCL,<
NORUN:	MOVE	1,[SIXBIT /COMPIL/]
	MOVSI	2,SAVEXT	;SIXBIT FOR SAV OR DMP
	SETZB	3,4
	INIT	CCLCHN,17
	SIXBIT	/SYS/
	0
	CALLI	12
	LOOKUP	CCLCHN,1
	CALLI	12
	CALL	1,[SIXBIT /SETNAM/]
	HLRO	15,4
	HRLM	15,NORUN1
	MOVNS	15
	MOVEI	16,73(15)
	ADDI	15,INHERE
	TRO	15,1777
	MOVSI	NORTOP,NORAC
	BLT	NORTOP,NORTOP
	HRR	NORBLT,16
	JRST	NORUN2
>

TYOCTL:	TRNE	FF,ARG		;ARGUMENT?
	JRST	TYOCT1		;YES.
				;NO, RETURN VALUE OF TYOCTF
	TLNE	FF,TYOCTF	;FLAG ON?
	JRST	FFOK		;YES, RETURN -1
	JRST	BEGIN		;NO, RETURN 0

TYOCT1:	TLZ	FF,TYOCTF	;CLEAR ET FLAG
	SKIPE	B		;ARGUMENT NON ZERO?
	TLO	FF,TYOCTF	;YES. SET ET FLAG
	JRST	RET		;RETURN
;ER	PREPARE TO READ FILE

OPNRD:	TLZ	FF,FINF+UREAD	;NOT EOF & CLOSE PREVIOUS INPUT
	RELEAS	INCHN,0		;YES. RELEASE IT BEFORE OPENING NEW FILE.
	PUSHJ	P,FILSPC	;GET FILE SPEC
	SETZM	OPNRI		;ASCII MODE
	MOVE	E,FILDEV	;INITIALIZE OPEN UUO ARGUMENTS
	MOVEM	E,OPNR1
	PUSHJ	P,DEVCHK	;GET DEVICE CHARACTERISTICS
	MOVEM	E,DEVSAV	;SAVE FOR EB
	MOVEI	E,IBUF
	MOVEM	E,OPNRB
	OPEN	INCHN,OPNRI	;OPEN INPUT FILE
	JRST	ININER
	PUSHJ	P,OPNIN
	LOOKUP	INCHN,FILNAM
	JRST	NOTTHR		;LOOKUP FAILURE
	TLO	FF,UREAD	;INPUT FILE NOW OPEN
	POPJ	P,

OPNIN:	MOVE	T,JOBFF		;GET INPUT BUFFERS
	MOVEI	E,IBUF1
	MOVEM	E,JOBFF
	INBUF	INCHN,2
	MOVEM	T,JOBFF
	POPJ	P,

EBAKUP:	TLNE	FF,UBAK		;EB ALREADY IN PROGRESS?
	ERROR	^D22		;YES
	TLZ	FF,UBAK		;CLR FLAG IN CASE OF FAILURE
	TLO	FF,UEBTMP	;SET IN CASE LOOKUP FAILS
	PUSHJ	P,OPNRD		;READ THE SPECIFIED FILE
	MOVE	E,DEVSAV	;GET DEVICE CHARACTERISTICS
	TLNN	E,4		;DTA OR DSK?
	ERROR	^D50		;NO
	MOVE	E,FILDEV	;SAVE DEVICE NAME
	MOVEM	E,EBDEV
	MOVE	E,USRPPN	;PROJ-PROG# = USER?
	CAME	E,FILPPN
	JRST	EBAKU2		;NO, JUST DO ER-EW
	MOVE	E,FILNAM	;SAVE IT
	MOVEM	E,BAKNAM	;IN BACKUP STORE
	HLLZ	E,FILNAM+1	;AND THE EXTENSION
	CAMN	E,[SIXBIT /BAK/]	;CANNOT USE EB WITH FILE EXT = "BAK"
	ERROR	^D47
	MOVEM	E,BAKNAM+1
	LDB	E,[POINT 9,FILNAM+2,8]	;SAVE PROTECTION OF INPUT FILE
	SKIPLE	MONITR		;SKIP IF 3 OR 4 SERIES MONITOR
	CAIGE	E,200		;MAY USER RENAME HIS FILE?
	CAIL	E,500		;REJECT 2+ IN LEVEL D, 5+ IN LEVEL C
	ERROR	^D51		;CANT RENAME
	MOVEM	E,PROTEC
	MOVE	E,TMPTEC	;GET "###TEC"
	CAME	E,FILNAM	;FILNAM=###TEC?
	JRST	EBAKU1		;NO, OK
	HLRZ	A,FILNAM+1	;ALSO EXT="TMP"?
	CAIN	A,(SIXBIT /TMP/)
	ERROR	^D47		;YES, EB###TEC.TMP ILLEGAL
EBAKU1:	MOVEM	E,FILNAM
	MOVEM	E,BAKTMP	;SAVE FOR DTA RENAME
	MOVSI	E,(SIXBIT /TMP/)
	MOVEM	E,FILNAM+1
	SETZM	FILNAM+2
	SETZM	FILNAM+3
	PUSHJ	P,OPNW4		;WRITE THE TMP FILE
	PUSHJ	P,OPNW2
	TLZE	FF,CCLFLG	;EB OR TECO COMMAND?
	PUSHJ	P,YANK		;TECO, DO A Y ALSO
	TLO	FF,UBAK
	POPJ	P,

NOTTHR:	TLNN	FF,UEBTMP	;WORKING ON EB?
	JRST	TYINPT		;NO, LOOKUP ERROR
	JSP	A,CONMES
	ASCIZ	/[CREATING NEW FILE]
/
	POP	P,E		;AFTER LOOKUP FAILURE IN OPNRD, RETURN FROM
				; OPNW2 TO PLACE WHERE EBAKUP WAS CALLED
EBAKU2:	TLZ	FF,CCLFLG	;CLR IN CASE WE GOT HERE FROM A TECO COMMAND
	HLLZS	FILNAM+1	;RESTORE FILE SPECS
	SETZM	FILNAM+2
	SETZM	FILNAM+3
	PUSHJ	P,OPNW4		;EXECUTE EW INSTEAD OF EB
	JRST	OPNW2

U OPNRI,1			;INPUT FILE OPEN ARGUMENTS, OPNRD+4(1)
U OPNR1,1			;INPUT DEVICE.  INIT+27(0),OPNRD+6
U OPNRB,1			;INITIALIZE TO XWD 0,INBUF. OPNRD+10
U BAKTMP,1			;FOR DECTAPE TEMP NAME
U PROTEC,1			;EB INPUT FILE PROTECTION
U DEVSAV,1			;DEVICE CHARACTERISTICS
U EBDEV,1			;EB DEVICE NAME
U TMPTEC,1			;SAVE FOR ###TEC. FILE NAME
;TYPE INPUT DEVICE ERROR

TYINPT:	RELEAS	INCHN,0
	TLZ	FF,UREAD	;LET GO OF INPUT DEVICE
	JSP	A,ERRMES
	ASCIZ	/INPUT ERROR.../
	JRST	ERRMG2

;TYPE OUTPUT ERROR

ENTERR:	RELEAS	OUTCHN,0
	TLZ	FF,UWRITE+UBAK	;LET GO OF OUTPUT DEVICE & EB FLAG
	JSP	A,ERRMES
	ASCIZ	/OUTPUT ERROR.../

;SELECT AND TYPE THE ERROR CONDITION GIVEN BY THE
;MONITOR IN RESPONSE TO ERRORS IN LOOKUP AND ENTER.
;TYPE 6 HAS NOT BEEN INVENTED YET, BUT MAY BE ENTERED
;INTO THE DISPATCH TABLE BELOW

ERRMG2:	MOVE	E,FILNAM+1	;GET ERROR NUMBER PROVIDED
	ANDI	A,-1		;INPUT OR OUTPUT SWITCH
	ANDI	E,7		;ISOLATE THE NUMBER FOR FURTHER OPERATIONS
	CAIN	A,ERRMG2-1	;WAS THIS AN OUTPUT ERROR?
	JUMPE	E,IOFN		;YES,TYPE 0 ERROR,ILL NAME
	HRRZ	A,EDSP(E)	;ANTICIPATE RIGHT BANK
	CAILE	E,3		;BE SURE THIS IS SO
	HLRZ	A,EDSP-4(E)	;BLUNDER
	JRST	@A		;PERFORM THE DISPATCHED ROUTINE

;UPDATE THIS DISPATCH TABLE IF 6 INVENTED

EDSP:	XWD	RNFAIL,NTFD	;RENAME.......NOT FOUND
	XWD	RNFAIL,IPP	;RENAME.......INCORRECT PP#
	XWD	USP,FPR		;UNDEFINED....FILE PROTECT FAILURE
	XWD	NDV,FBM		;NO DEVICE....FILE BEING MODIFIED
;TYPE 0 ERROR ON INPUT ONLY

NTFD:	PUSHJ	P,LKUPER	;TYPE NAME.EXT
	JSP	A,CONMES
	ASCIZ	/ FILE NOT FOUND
/
	ERROR	^D12

;TYPE 0 ERROR ON OUTPUT ONLY

IOFN:	SKIPE	FILNAM
	JRST	DIF
	JSP	A,CONMES
	ASCIZ	/ ILLEGAL NAME FORMAT
/
	ERROR	^D13

;TYPE 1 ERROR, ILLEGAL PROJECT PROGRAMMER NUMBER

IPP:	PUSHJ	P,LKUPER	;TYPE NAME.EXT
	JSP	A,CONMES
	ASCIZ	/ INCORRECT PROJECT-PROGRAMMER NUMBER
/
	ERROR	^D14

;TYPE 2 ERROR, FILE PROTECT FAILURE

FPR:	PUSHJ	P,LKUPER	;TYPE NAME.EXT
	JSP	A,CONMES
	ASCIZ	/ FILE PROTECT FAILURE
/
	ERROR	^D15

;TYPE 3 ERROR, FILE BEING MODIFIED

FBM:	PUSHJ	P,LKUPER	;TYPE NAME.EXT
	JSP	A,CONMES
	ASCIZ	/ FILE BEING MODIFIED
/
	ERROR	^D16

;TYPE 6 NOT YET INVENTED

USP:	PUSHJ	P,LKUPER	;TYPE NAME.EXT
	JSP	A,CONMES
	ASCIZ	% UNDEFINED I/O ERROR
%
	ERROR	^D17

;TYPE 7 ERROR, NO DEVICE

NDV:	JSP	A,CONMES
	ASCIZ	/ NO DEVICE ASSIGNED
/
	ERROR	^D18

;DIRECTORY FULL MESSAGE

DIF:	JSP	A,CONMES
	ASCIZ	/DIRECTORY IS FULL
/
	ERROR	^D19



ININER:	JSP	A,ERRMES
	ASCIZ	/DEVICE /
	MOVE	A,FILDEV
	PUSHJ	P,SIXBMS
	JSP	A,CONMES
	ASCIZ	/ NOT AVAILABLE
/
	ERROR	^D20

LKUPER:	MOVE	A,FILNAM
	PUSHJ	P,SIXBMS
	HLLZ	A,FILNAM+1
	JUMPE	A,LKUPE1
	MOVEI	CH,"."
	PUSHJ	P,TYO
	PUSHJ	P,SIXBMS
LKUPE1:	POPJ	P,
	ERROR	^D21

RNFAIL:	PUSHJ	P,LKUPER	;TYPES 4,5
	JSP	A,CONMES
	ASCIZ	/ RENAME FAILURE
/
	ERROR	^D45
;EW	SELECTS THE OUTPUT DEVICE AND OPENS THE FILE SPECIFIED (IF ANY)

OPNWR:	PUSHJ	P,OPNW1


OPNW2:	ENTER	OUTCHN,FILNAM
	JRST	ENTERR
	TLO	FF,UWRITE	;OUTPUT FILE NOW OPEN
	POPJ	P,



OPNW1:	TLNE	FF,UBAK
	ERROR	^D22
	PUSHJ	P,FILSPC
OPNW4:	TLZ	FF,UWRITE	;CALL HERE FROM EB
	RELEAS	OUTCHN,0
	SETZM	OPNWI
	MOVE	E,FILDEV
	MOVEM	E,OPNWD
	PUSHJ	P,DEVCHK	;GET DEVICE CHARACTERISTICS
	MOVEM	E,WRICHR
	MOVSI	E,OBF
	MOVEM	E,OPNWB
	OPEN	OUTCHN,OPNWI
	JRST	ININERR
	MOVE	T,JOBFF
	MOVEI	E,OBUF1
	MOVEM	E,JOBFF
	OUTBUF	OUTCHN,2
	MOVEM	T,JOBFF
	POPJ	P,

U OPNWI,1			;OUTPUT FILE OPEN ARGUMENTS. OPNW1+4(1)
U OPNWD,1			;OUTPUT DEVICE.  OPNW1+6
U OPNWB,1			;OUTBUT BUFFER HEADER ADDRESS. OPNW1+10(OUTBUF)
U WRICHR,1			;CHARACTERISTICS OF WRITE DEVICE

;GET I-O DEVICE CHARACTERISTICS IN AC E
;IF TTY, IT MUST BE AVAILABLE & NOT CONTROLLING A JOB

DEVCHK:	CALLI	E,DEVCHR	;GET CHARACTERISTICS
	TLNN	E,10		;TTY?
	POPJ	P,		;NO
	TLNE	E,40		;YES, AVAILABLE?
	TLNE	E,20000		;CONTROLLING A JOB (INCLUDING USER)?
	ERROR	^D48		;CAN'T HAVE IT
	POPJ	P,		;IT'S OK
;EZ	SELECTS THE OUTPUT DEVICE, ISSUES A REWIND COMMAND TO IT,
;	ISSUES A COMMAND TO ZERO ITS DIRECTORY, AND OPENS THE FILE
;	SPECIFIED (IF ANY).

ZERDIR:	PUSHJ	P,OPNW1		;DETERMINE OUTPUT DEVICE
	CALLI	OUTCHN, UTPCLR	;CLEAR DIRECTORY OF OUTPUT DEVICE
	MTAPE	OUTCHN,1	;REWIND OUTPUT DEVICE
	JRST	OPNW2		;ENTER FILE




;EF	FINISHES OUTPUT ON THE CURRENT OUTPUT FILE WITHOUT
;	SELECTING A NEW OUTPUT FILE.

CLOSEF:	TLZN	FF,UWRITE
	POPJ	P,
	CLOSE	OUTCHN,2
	STATZ	OUTCHN,740000
	JRST	OUTERR
	TLZE	FF,UBAK		;EB IN PROGRESS?
	PUSHJ	P,BAKCLS	;YES
	RELEAS	OUTCHN,0
	POPJ	P,
;EM	EXECUTE MTAPE UUO.

EMTAPE:	TLNN	FF,UREAD
	ERROR	^D23
	PUSHJ	P,CHK2
	CAIGE	B,20
	CAIGE	B,1
	ERROR	^D24
	MTAPE	INCHN,0(B)
	OPEN	INCHN,OPNRI	;RE-INIT BUFFERS
	JRST	ININER
	PUSHJ	P,OPNIN
	POPJ	P,

;THIS ROUTINE IS CALLED AT EF IF AN EB WAS DONE. IT DOES
;THE WORK OF MAKING THE INPUT FILE HAVE THE EXTENSION .BAK ,
;DELETING ANY PREVIOUS FILE.BAK, AND RENAMING THE NEW OUTPUT
;FILE AS THE ORIGINAL FILE.EXT

BAKCLS:	CLOSE	INCHN,0
	MOVE	E,EBDEV		;ORIGINAL EB DEVICE
	TLON	FF,UREAD	;INPUT OPEN?
	JRST	BKCLS4		;NO
	CAMN	E,OPNR1		;ORIGINAL SAME AS CURRENT?
	JRST	BKCLS2		;YES
BKCLS4:	MOVEM	E,OPNR1		;NO, RE-OPEN ORIGINAL
	OPEN	INCHN,OPNRI
	JRST	ININER		;FAILURE
BKCLS2:	MOVE	E,BAKNAM
	MOVEM	E,FILNAM
	MOVSI	E,(SIXBIT /BAK/)
	MOVEM	E,FILNAM+1
	SETZM	FILNAM+3
	LOOKUP	INCHN,FILNAM
	JRST	BKCLS1
	CLOSE	INCHN,0
	SETZM	FILNAM
	SETZM	FILNAM+1
	SETZM	FILNAM+3
	RENAME	INCHN,FILNAM
	ERROR	^D52
BKCLS1:	MOVE	E,BAKNAM
	MOVEM	E,FILNAM
	HLLZ	E,BAKNAM+1
	MOVEM	E,FILNAM+1
	SETZM	FILNAM+3
	LOOKUP	INCHN,FILNAM
	JRST	ENTERR
	CLOSE	INCHN,0
	MOVSI	E,(SIXBIT /BAK/)
	MOVEM	E,FILNAM+1
	SETZM	FILNAM+3
	RENAME	INCHN,FILNAM
	JRST	ENTERR
	MOVE	E,DEVSAV	;GET INPUT DEVICE CHARCATERISTICS
	TLNN	E,100		;DECTAPE?
	JRST	BKCLS3		;NO
	MOVE	A,BAKTMP	;DECTAPE NEEDS A SECOND LOOKUP
	MOVEM	A,FILNAM	;ON ###TEC.TMP (SO DO MONITORS BEFORE 5 SERIES)
	MOVSI	A,(SIXBIT /TMP/)
	MOVEM	A,FILNAM+1
	SETZM	FILNAM+3
	LOOKUP	OUTCHN,FILNAM
	JRST	ENTERR
	CLOSE	OUTCHN,2	;CLOSE OUTPUT FOR RENAME
BKCLS3:	MOVE	E,BAKNAM	;RENAME ###TEC.TMP TO ORIGINAL NAME
	MOVEM	E,FILNAM
	MOVE	E,BAKNAM+1
	MOVEM	E,FILNAM+1
	SETZM	FILNAM+2	;CLEAR CREATION TIME
	MOVE	E,PROTEC	;EB OUTPUT FILE GETS SAME PROTECTION
	DPB	E,[POINT 9,FILNAM+2,8]	; AS INPUT FILE
	SETZM	FILNAM+3
	RENAME	OUTCHN,FILNAM
	JRST	ENTERR
	POPJ	P,
;ROUTINE TO PARSE FILE DESIGNATOR

FILSPC:	TLZ	FF,FILWD+FEXTF
	SETZM	FILDEV		;CLEAR FILE DESIGNATOR ARGUMENTS.
	MOVE	E,USRPPN	;& INIT PROJ-PROG # TO USER
	MOVEM	E,FILPPN
	SETZM	FILNAM
	SETZM	FILNAM+1
	SETZM	FILNAM+2
	SETZB	E,FILNAM+3

;FROM FILSPL+21,FILSP1+3,FILSP3+3,FILSP6+1


FILSPL:	PUSHJ	P,SKRCH		;GET NEXT COM CHARACTER. ERROR IF COMMAND BUFFER EMPTY.
	CAIN	CH,175
	JRST	FILSP2		;ALT MODE
	CAIL	CH,140		;LC TO UC
	TRZ	CH,40
	CAIN	CH,":"
	JRST	FILSP1		;DEVICE
	CAIN	CH,"."
	JRST	FILSP3		;EXTENSION MARK
	CAIN	CH,"["
	JRST	FILSP4		;PROJ PROG PAIR
	PUSHJ	P,DQT2		;LETTER OR DIGIT?
	TRZA	B,777700	;YES. DQT2 LEAVES CHARACTER IN B AND CH.
	ERROR	^D26		;NO
	TRC	B,40		;CONVERT TO SIXBIT.
	ROT	B,-6
	TLNN	E,770000	;SIX CHARACTERS YET?
	ROTC	B,6		;NO. PACK IT INTO E
	TLO	FF,FILWD	;YES.
	JRST	FILSPL
;END OF DESIGNATOR.  STORE FILE NAME OR EXTENSION AND RETURN
;THROW IN DSK IF NEEDED

FILSP2:	PUSHJ	P,FILLSH
	MOVSI	E,(SIXBIT /DSK/)
	SKIPN	FILDEV
	MOVEM	E,FILDEV
	POPJ	P,


;ROUTINE TO LEFT JUSTIFY E AND STORE IN FILE NAME OR FILE EXTENSION.
;CALL	MOVE E,SIXBIT NAME RIGHT JUSTIFIED
;	SET FILWD OR FEXTF FLAG
;	PUSHJ P,FILLSH
;	RETURN
;FROM FILSP1,FILSP3,FILSP4

FILLSH:	SKIPE	E		;NULL NAME?
	TLNE	E,770000	;NO. LEFT JUSTIFIED?
	JRST	FILLS1		;YES.
	LSH	E,6		;NO.
	JRST	.-3
FILLS1:	TLZN	FF,FEXTF	;EXTENSION?
	JRST	.+3		;NO.
	HLLZM	E,FILNAM+1	;YES. STORE IT.
	TLZ	FF,FILWD
	TLZE	FF,FILWD	;FILE NAME?
	MOVEM	E,FILNAM	;YES. STORE IT.
	POPJ	P,		;NO. RETURN.
;DEVICE NAME

FILSP1:	TLZ	FF,FILWD+FEXTF	;RESET THESE FLAGS FOR DEVICE LOAD
	PUSHJ	P,FILLSH	;LEFT JUSTIFY IT.
	MOVEM	E,FILDEV
FILS1A:	MOVEI	E,0
	JRST	FILSPL

;FILE NAME EXTENSION FOLLOWS

FILSP3:	PUSHJ	P,FILLSH	;STORE FILE NAME.
	TLO	FF,FEXTF	;GET EXTENSION.
	JRST	FILS1A

;PROJECT-PROGRAMMER PAIR

FILSP4:	PUSHJ	P,FILLSH	;STORE NAME OR EXTENSION.
	MOVEI	B,","		;SCAN FOR ,
	PUSHJ	P,FILSPP
FILSP5:	HRLZM	E,FILNAM+3	;STORE PROJECT NUMBER.
	MOVEI	B,"]"		;SCAN FOR ]
	PUSHJ	P,FILSPP
FILSP6:	HRRM	E,FILNAM+3
	MOVE	E,FILNAM+3	;SAVE IN CASE DOING EB
	MOVEM	E,FILPPN
	JRST	FILSPL

FILSPP:	MOVEI	E,0
FILS4L:	PUSHJ	P,SKRCH		;GET NEXT COMMAND CHARACTER.
	CAIN	CH,(B)		;DELIMITER?
	POPJ	P,		;YES
	PUSHJ	P,FILSOC
	JRST	FILS4L


FILSOC:	XORI	CH,60
	CAIL	CH,12
	ERROR	^D27
	LSH	E,3
	ADDI	E,(CH)
	POPJ	P,
;Y	RENDER THE BUFFER EMPTY.  READ INTO THE BUFFER UNTIL
;	(A)  A FORM FEED CHARACTER IS READ, OR
;	(B)  THE BUFFER IS WITHIN ONE THIRD OR
;128 CHARACTERS OF CAPACITY AND A LINE FEED IS READ, OR
;	(C)  AN END OF FILE IS READ, OR
;	(D)  THE BUFFER IS COMPLETELY FULL.
;THE FORM FEED (IF PRESENT) DOES NOT ENTER THE BUFFER.

YANK:

YANK1:	MOVE	OU,BEG
	MOVEM	OU,PT		;PT:=BEG

YANK2:	TRZ	FF,FORM		;RESET THE YANK,APPEND FORM FEED FLAG
	TLNN	FF,UREAD	;HAS AN INPUT FILE BEEN SPECIFIED?
	JRST	YANK09		;NO.

;MAINTAIN AT LEAST A MINIMUM SIZE BUFFER OF 5000 
;CHARACTERS AT ALL TIMES, WHEN TECO ASKS FOR INPUT FROM
;ANYTHING BUT THE CONSOLE.

	PUSH	P,17		;SAVE AC#17
	MOVE	17,MEMSIZ	;TOTAL CHARACTERS AVAILABLE
	SUB	17,OU		;THIS IS TOTAL IN BUFFER FOR Y (OR P),
				; OR ABOVE BUFFER IF "A" COMMAND
	CAIG	17,^D3000	;HAVE WE 3000 CHARACTERS?
	PUSHJ	P,GRABAK	;NO, GET 1 K OF CORE
	POP	P,17		;RESTORE AC#17

YANK4:	MOVE	T,M23		;CHECK IF THERE IS ENOUGH SPACE
	CAIL	T,(OU)		;WITHIN 128 CHARACTERS FROM TOP OF MEMORY?
	JRST	YANK3		;NO. GET MORE.
	MOVE	T,M23PL		;!!!!!!!!!!!!!!TEST!!!!!!!!!
	CAILE	T,0(OU)		;YES. FULL?
	CAIN	CH,12		;NO. LINE FEED?
	JRST	YANK51		;YES. THAT'S ALL.
				;NO. GET MORE.

YANK3:	SOSLE	IBUF+2		;YES. IS DEVICE BUFFER EMPTY?
	JRST	YANK5		;NO.
	INPUT	INCHN,0		;YES. FILL IT.
	STATZ	INCHN,740000	;ERROR?
	JRST	INERR		;YES.
	STATO	INCHN,20000	;NO. END OF FILE?
	JRST	YANK5		;NO.
	TLO	FF,FINF
	JRST	YANK51		;CLEAR BUFFER AND RETURN.
YANK5:	ILDB	CH,IBUF+1	;CH:=NEXT CHARACTER.
	JUMPE	CH,YANK3	;IF NULL, IGNORE IT.
	MOVE	T,@IBUF+1
	TRNE	T,1		;SEQUENCE NUMBER?
	JRST	YNKSEQ		;YES. IGNORE THEM.
	PUSHJ	P,PUT		;NO. PUT CHARACTER IN DATA BUFFER.
	CAIE	CH,14		;FORM FEED?
	AOJA	OU,YANK4	;NO. UPDATE DATA BUFFER POINTER AND CHECK FOR OVERFLOW.
	TRO	FF,FORM		;YANK AND/OR APPEND TERMINATED ON A LFORM FEED
YANK51:	MOVEM	OU,Z		;YES. SET END OF DATA BUFFER AND RETURN
	POPJ	P,
YANK09:	JSP	A,ERRMES	;NO.
	ASCIZ	/NO FILE FOR INPUT
/
	ERROR	^D28


YNKSEQ:	MOVNI	T,5		;IGNORE SEQ. NO. AND FOLLOWING TAB
	ADDM	T,IBUF+2	;DECREASE CHAR COUNT BY 5
	AOS	IBUF+1		;INCREMENT POINTER OVER SEQ. NO., & TAB
	JRST	YANK3
INERR:	RELEAS	INCHN,0
	TLZ	FF,UREAD
	JSP	A,ERRMES
	ASCIZ	/ERROR ON INPUT DEVICE
/
	ERROR	^D29



;A   APPEND TO THE END OF THE BUFFER FROM THE SELECTED INPUT
;	TERMINATING THE READ IN THE SAME MANNER AS Y.  THE POINTER
;	IS NOT MOVED BY A.

APPEND:	MOVE	OU,Z		;STORE DATA AT END OF BUFFER.
	PUSHJ	P,YANK2
	JRST	RET
;^ITEXT$	INSERTS AT THE CURRENT POINTER LOCATION THE ^I (TAB)
;	AND THE TEXT FOLLOWING THE ^I UP TO BUT NOT INCLUDING THE
;	ALT MODE.  THE POINTER IS PUT TO THE RIGHT OF THE INSERTED
;	MATERIAL.

TAB:	PUSHJ	P,TAB2		;INSERT TAB

;ITEXT$	INSERT, AT THE CURRENT POINTER LOCATION, THE TEXT FOLLOWING
;	THE I UP TO BUT NOT INCLUDING THE FIRST ALT. MODE.  THE
;	POINTER IS PUT TO THE RIGHT OF THE INSERTED MATERIAL.

INSERT:	TRNE	FF,ARG		;IS THERE AN ARGUMENT?
	JRST	INS1A		;YES. NI COMMAND.
	MOVEI	CH,175		;NO. CH:=ALT-MODE.
	TRZE	FF,SLSL		;DID @ PRECEED I?
	PUSHJ	P,RCH		;YES. CH:=USER SELECTED TERMINATOR.
	MOVEM	CH,A		;A:=INSERTION TERMINATOR.
				;EITHER ALT-MODE OR USER CHOICE.
	MOVE	B,CPTR		;SAVE CURRENT POSITION OF CPTR.
	MOVEI	C,0		;COUNT # CHARACTERS TO INSERT IN C AND
				;MOVE CPTR TO END OF STRING.
	PUSHJ	P,SKRCH		;GET NEXT CHARACTER
	CAME	CH,A		;IS IT THE TERMINATOR?
	AOJA	C,.-2		;NO. TRY AGAIN.
	PUSHJ	P,NROOM		;YES. MOVE FROM PT THROUGH Z UP C POSITIONS.
	ADD	B,CRREL		;RELOCATE INITIAL VALUE OF CPTR IN CASE OF GARB. COL.

;MOVE INSERTION INTO DATA BUFFER

INS1B:	MOVE	OU,PT
	ILDB	CH,B		;CH:=CHARACTER FROM COMMAND STRING.
	CAMN	CH,A		;IS IT THE TERMINATOR?
	POPJ	P,		;YES. DON'T STORE IT.
	PUSHJ	P,PUT		;NO. STORE CHARACTER IN DATA BUFFER TO RIGHT OF PT.
	AOS	PT		;PT:=PT+1
	JRST	INS1B		;LOOP
;NI	INSERT AT THE POINTER A CHARACTER WHOSE 7-BIT ASCII CODE IS N
;	(BASE 10).  THE POINTER IS MOVED TO THE RIGHT OF THE NEW CHARACTER.

INS1A:
TAB1:	MOVE	CH,NUM		;CH:=NUM

;INSERT CH IN DATA BUFFER AT PT

TAB2:	MOVEI	C,1		;MOVE FROM PT THROUGH Z UP 1 POSITION.
	PUSHJ	P,NROOM
	AOS	OU,PT		;PT:=PT+1
	SOJA	OU,PUT		;STORE CH AT PT-1




;@IJTEXTJ	INSERT, AT THE CURRENT POINTER POSITION, THE TEXT
;	SURROUNDED BY THE INSTANCES OF THE TERMINATOR J, WHICH MAY BE AT
;	THE USER'S CHOICE ANY CHARACTER NOT APPEARING IN THE TEXT.
;	THE POINTER IS PUT TO THE RIGHT OF THE INSERTED MATERIAL.

ATSIGN:	TRO	FF,SLSL		;SLSL:=1
	JRST	RET


;NBACKSLASH	INSERT AT THE CURRENT POINTER LOCATION THE ASCII NUMBERS
;	EQUAL TO N.

BAKSL1:	MOVE	T,[XWD 700,BAKTAB-1]
	MOVEI	C,0		;COUNT # DIGITS IN C.
	MOVEI	CH,BAKSL4	;SET DPT TO RETURN TO BAKSL4
	HRRM	CH,LISTF5
	PUSHJ	P,DPT		;CONVERT C(B) TO ASCII AND STORE STRING IN BAKTAB.
	MOVEI	A,141		;MARK END OF STRING IN BAKTAB
	IDPB	A,T
	MOVE	B,[XWD 700,BAKTAB-1]
	PUSHJ	P,NROOM		;MOVE FROM PT THROUGH Z UP C POSITIONS.
	PUSHJ	P,INS1B		;INSERT STRING IN BAKTAB INTO DATA BUFFER AT PT.
	JRST	RET

BAKSL4:	IDPB	CH,T		;STORE DIGIT IN BAKTAB
	AOJA	C,CPOPJ		;C:=C+1. RETURNS TO DPT CALL + 1 ON COMPLETION.
;NT	TYPE OUT THE STRING OF CHARACTERS STARTING AT THE RIGHT OF THE
;	POINTER AND CONTINUING THROUGH THE NTH LINE FEED ENCOUNTERED.
;	IF N IS NEGATIVE, N LINES TO THE LEFT OF THE POINTER ARE TYPED.
;T	SAME AS 1T.
;I,JT	TYPE OUT THE (I+1)TH THROUGH THE JTH CHARACTER OF THE BUFFER.

TYPE:
TYPE4:	MOVEI	D,TYO		;D:=ADDRESS OF OUTPUT ROUTINE.

TYPE0:	PUSHJ	P,GETARG	;C:=FIRST STRING ARGUMENT ADDRESS.
				;B:=SECOND STRING ARGUMENT ADDRESS.

TYPE1:	PUSHJ	P,CHK1		;C:=MAX(C(C),BEG), B:=MIN(C(B),Z)
	MOVE	I,C		;START GETTING CHARACTERS AT C.
TYPE3:	CAML	I,B		;DONE?
	JRST	TYPE5		;YES.
	MOVE	TT,I		;NO. GET NEXT CHAR
	IDIVI	TT,5		;THIS IS A COPY OF GETINC
	HLL	TT,BTAB(TT1)	;..
	LDB	CH,TT		;COPIED TO SPEED IT UP
	ADDI	I,1		;..
	PUSHJ	P,(D)		;OUTPUT IT
	JRST	TYPE3		;LOOP
TYPE5:	MOVEI	A,PPA		;IF TYPING OR I,JP DON'T APPEND FF.
	MOVEI	CH,14		;IF PUNCHING, APPEND FF.
	CAIE	A,(D)		;D=PPA?
	POPJ	P,		;NO
	TRNN	FF,PCHFLG	;IS THIS AN "N" SEARCH?
CPPA:	JRST	PPA		;NO, APPEND A FORM FEED
	TRNN	FF,FORM		;DID LAST Y,A TERMINATE ON A FORM FEED?
	POPJ	P,		;NO,DO NOT APPEND ONE
				;YES, FALL INTO PPA: TO APPEND FF
PPA:	TLNN	FF,UWRITE	;OUTPUT FILE OPEN?
	JRST	PPA09		;NO.
	SOSLE	OBF+2		;YES. IS OUTPUT BUFFER FULL?
	JRST	PPA01		;NO.
	OUTPUT	OUTCHN,0	;YES. WRITE IT
	STATZ	OUTCHN,740000	;ERROR?
	JRST	OUTERR		;YES.
	PUSH	P,A
	MOVE	A,WRICHR
	TLNE	A,DVMTA
	STATO	OUTCHN,IOEOT	;A MAG TAPE AND AFTER EOT?
	SKIPA			;NO
	JRST	OUTERR
	POP	P,A
PPA01:	IDPB	CH,OBF+1	;NO. CH TO OUTPUT BUFFER.
	POPJ	P,		;RETURN

PPA09:	JSP	A,ERRMES
	ASCIZ	/NO FILE FOR OUTPUT
/
	ERROR	^D30

OUTERR:	RELEAS	OUTCHN,0	;CLOSE FILE AND RELEASE OUTPUT DEVICE.
	JSP	A,ERRMES
	ASCIZ	/ERROR ON OUTPUT DEVICE; FILE CLOSED
/
	TLZ	FF,UWRITE+UBAK	;CLEAR OUTPUT FILE OPEN INDICATOR.
	ERROR	^D2
;PW	OUTPUT THE ENTIRE BUFFER, FOLLOWED BY A FORM FEED CHARACTER.
;	TO THE SELECTED OUTPUT DEVICE.  BUFFER IS UNCHANGED AND POINTER
;	IS UNMOVED.
;P	IS IDENTICAL TO PWY.
;NP	IS IDENTICAL TO PP...P (P PERFORMED N TIMES).
;I,JP	OUTPUTS (I+1)TH THROUGH JTH CHARACTERS OF BUFFER.  NO FORM
;	FEED IS PUT AT THE END.  BUFFER UNCHANGED; POINTER UNMOVED.

PUNCH:

PUNCHA:	MOVEI	D,CPPA		;SELECT PPA FOR OUTPUT INDIRECTLY IN CASE I,JP.
	TRNE	FF,ARG2		;I,JP?
	JRST	TYPE0		;YES. GET STRING ARGUMENTS AND OUTPUT.
	MOVE	E,B		;NO. E:=N
	MOVE	B,CPTR
	ILDB	T,B		;T:=COMMAND CHARACTER FOLLOWING P.
	TRZ	T,40		;FILTER L.C.
	JUMPL	E,CPOPJ		;IF N<0, IGNORE P.
PUN1:	PUSHJ	P,PUNCHR	;PUNCH OUT BUFFER
	SKIPE	COMCNT		;IF NO COMMANDS LEFT
	CAIE	T,"W"		;OR COMMAND IS NOT W
	JRST	PUN3		;READ NEXT PAGE
PUN4:	MOVE	C,Z
	CAMN	C,BEG		;EMPTY BUFFER?
	TLNN	FF,FINF		;NO. QUIT ON EOF
	SOJG	E,PUN1		;YES. E:=E-1. DONE?
CPOPJ:	POPJ	P,		;YES

PUN2:	MOVE	OU,BEG		;IF NOTHING READ IN, CLEAR THE BUFFER
	MOVEM	OU,PT
	TRZ	FF,FORM		;AND THE FORM FEED FLAG
	JRST	YANK51		;SET Z=BEG & POPJ

PUNCHR:	MOVE	C,BEG		;OUTPUT DATA BUFFER.
	MOVE	B,Z
	MOVEI	D,PPA
	CAMN	B,C		;IS PAGE BUFFER EMPTY?
	POPJ	P,		;YES, DON'T PUNCH
	JRST	TYPE1

PUN3:	TLNE	FF,UREAD	;ANY INPUT FILE?
	TLNE	FF,FINF		;DONT TRY TO READ IF NO DATA LEFT
	JRST	PUN2
	PUSHJ	P,YANK1		;RENEW BUFFER
	JRST	PUN4		;CONTINUE
;NJ	MOVE THE POINTER TO THE RIGHT OF THE NTH CHARACTER IN THE
;	BUFFER. (I.E., GIVE "." THE VALUE N.)
;J	SAME AS 0J.

JMP:	ADD	B,BEG		;PT:=N+BEG
	JRST	JMP1



;NR	SAME AS .-NJ.

REVERS:	PUSHJ	P,CHK2		;MAKE SURE THERE IS AN ARGUMENT
	MOVNS	B		;B:=-C(B)
	SKIPA

;NC	SAME AS .+NJ.  NOTE THAT N MAY BE NEGATIVE.

CHARAC:	PUSHJ	P,CHK2		;MAKE SURE THERE IS AN ARGUMENT
	ADD	B,PT		;B:=PT+C(B)

;IF B LIES BETWEEN BEG AND Z, STORE IT IN PT.

JMP1:	PUSHJ	P,CHK		;IS C(B) WITHIN DATA BUFFER?
	MOVEM	B,PT		;YES. PT:=C(B)
	JRST	RET

;NL	IF N>0:	MOVE POINTER TO THE RIGHT, STOPPING WHEN IT HAS
;		PASSED OVER N LINE FEEDS.
;	IF N<0:	MOVE POINTER TO THE LEFT; STOP WHEN IT HAS PASSED
;		OVER N+1 LINE FEEDS AND THEN MOVE IT TO THE RIGHT OF
;		THE LAST LINE FEED PASSED OVER.
;L	SAME AS 1L.

LINE:	TRNE	FF,ARG2		;IS THERE A SECOND ARGUMENT?
	ERROR	^D31		;YES. TOUGH
	PUSHJ	P,GETARG	;NO. C:=FIRST STRING ARGUMENT ADDRESS,
				;B:=SECOND STRING ARGUMENT ADDRESS.
	XOR	B,C
	XORM	B,PT
	JRST	RET
;ROUTINE TO RETURN CURRENT ARGUMENT IN B
;ASSUMES A VALUE OF 1 WITH SIGN OF LAST OPERATOR IF THERE IS NO CURRENT ARGUMENT
;CALL	PUSHJ P,CHK2
;	RETURN WITH B:=CURRENT ARG.,+1 OR -1

CHK2:	TROE	FF,ARG		;IS THERE AN ARGUMENT?
	POPJ	P,		;YES. IT'S ALREADY IN B.
				;NO

CHK22:	LDB	B,[XWD 340200,DLIM]	;B:=1 WITH SIGN OF LAST OPERATOR.
	MOVNS	B
	AOJA	B,CPOPJ

;CD9(K)
;NK	PERFORM NL BUT DELETE EVERYTHING THE POINTER MOVES OVER.
;M,NK	DELETE THE (M+1)TH THROUGH THE NTH CHARACTER FROM THE BUFFER.
;	THE POINTER IS THEN PUT WHERE THE DELETION TOOK PLACE.
;K	SAME AS 1K

KILL:	PUSHJ	P,GETARG	;C:=FIRST STRING ARG. ADDRESS
				;B:=SECOND STRING ARG. ADDRESS
	PUSHJ	P,CHK1		;C:=MAX(C(C),BEG), B:=MIN(C(B),Z)
	MOVEM	C,PT		;PT:=C(C)
	SUB	B,C		;B:=NO. OF CHARACTERS TO KILL.
	JUMPE	B,RET		;IF NONE, RETURN. OTHERWISE, FALL INTO DELETE
;ND	DELETE N CHARACTERS FROM THE BUFFER: IF N IS POSITIVE, DELETE
;	THEM JUST TO THE RIGHT OF THE POINTER; IF N IS NEGATIVE, DELETE
;	THEM JUST TO ITS LEFT.
;D	SAME AS 1D

DELETE:	PUSHJ	P,CHK2		;MAKE SURE B CONTAINS AN ARGUMENT
	MOVM	C,B
	MOVNS	C		;C:=-ABS(B)
	ADD	B,PT		;B:=PT+B
	PUSHJ	P,CHK		;STILL IN DATA BUFFER?
	CAMGE	B,PT		;YES. IS N NEGATIVE?
	MOVEM	B,PT		;YES. MOVE PT BACK FOR DELETION.
	PUSHJ	P,NROOM		;MOVE FROM PT+ABS(C) THROUGH Z DOWN ABS(C) POSITIONS
DEL2:
JRET:	JRST	RET



;ROUTINE TO CHECK DATA BUFFER POINTER
;CALL	MOVE B,POINTER
;	PUSHJ P,CHK
;	RETURN IF B LIES BETWEEN BEG AND Z

CHK:	CAMG	B,Z
	CAMGE	B,BEG
	ERROR	^D32
	POPJ	P,

;ROUTINE TO PUT STRING ARGUMENT ADDRESSES WITHIN DATA BUFFER
;BOUNDS AND CHECK ORDER RELATION.
;CALL	MOVE C,FIRST STRING ARGUMENT ADDRESS
;	MOVE B,SECOND STRING ARGUMENT ADDRESS
;	PUSHJ P,CHK1
;	RETURN
;C:=MAX(C(C),BEG), B:=MIN(C(B),Z)
;IF C>B, DOES NOT RETURN.

CHK1:	CAMG	C,BEG		;C:=MAX(C(C),BEG)
	MOVE	C,BEG
	CAML	B,Z		;B:=MIN(C(B),Z)
	MOVE	B,Z
	CAMLE	C,B		;C>B?
	ERROR	^D33		;YES.
	POPJ	P,		;NO
LARR:	TROA	FF,FINDR	;FINDR:=1 FOR LEFT ARROW SEARCH

SERCHP:	TRO	FF,PCHFLG	;PCHFLG:=1 FOR N SEARCH

;CD9(S)

SERCH:	MOVE	E,B		;E:=ARGUMENT (IF ANY)
	CLEARM	NUM		;NUM:=0
	MOVEI	CH,175		;USE ALT-MODE DELIMITER IF NO @ SEEN
	TRZE	FF,SLSL		;@ SEEN?
	PUSHJ	P,RCH		;YES. CH:=USER SPECIFIED DELIMITER.
	MOVEM	CH,B		;B:=SEARCH STRING DELIMITER
	HRLZI	F,STAB-STABP	;F:=XWD -LENGTH OF SEARCH TABLE,0

;SET UP SEARCH TABLE

SERCH2:	PUSHJ	P,SKRCH		;CH:=NEXT COMMAND STRING CHARACTER.
	CAIN	CH,(B)		;DELIMITER?
	JRST	SERCH1		;YES. DONE.
	CAIN	CH,30		;NO. ^X?
	JRST	CNTRX		;YES
	CAIN	CH,16		;NO. ^N?
	JRST	CNTRN		;YES.
	CAIN	CH,23		;NO. ^S?
	JRST	CNTRB		;YES
	CAIN	CH,21		;NO. ^Q?
	PUSHJ	P,SKRCH		;YES. ^Q TAKES THE NEXT CHARACTER.
	HRLI	CH,306000+CH*40	;CH:=CAIN CH,CHARACTER

SERCH4:	TRZE	FF,NOTF		;SEARCH SENSE REVERSED?
	TLC	CH,4000		;YES. CH:=CAIE CH,CHARACTER
				;PUSHJ P,CNTRB1, OR CAIA
	MOVEM	CH,STAB(F)	;SAVE IN SEARCH TABLE
	AOBJN	F,SERCH2	;GET NEXT CHARACTER
	ERROR	^D34		;SEARCH TABLE IS FULL
;START SEARCHING

SERCH1:	MOVE	I,PT		;START SEARCHING AT PT
S1:	TRNE	FF,ARG		;IS THERE AN ARGUMENT?
	JUMPLE	E,FND		;YES. SEEN STRING N TIMES?
	MOVE	TT,I		;NO, FORM BYTE PTR WHICH WILL BE
	SUBI	TT,1		; INCREMENTED BEFORE USE
	IDIVI	TT,5
	HLL	TT,BTAB(TT1)
	TRNE	F,777777	;QUIT IF THERE IS NO ARGUMENT
S3:	CAML	I,Z		;NO. REACHED TOP OF BUFFER?
	JRST	NOFND		;YES.
	MOVEI	D,STAB
	SKIPA	TT1,TT		;SET DYNAMIC PTR=STATIC PTR
S4:	ADDI	I,1		;LOOK AT NEXT LOC, XCEPT 1ST TIME THRU
	CAIN	D,STAB(F)	;END OF SEARCH TABLE?
	JRST	FND		;YES.
	ILDB	CH,TT1		;NO, GET NEXT CHAR
	XCT	(D)

SERCH5:	AOJA	D,S4		;MATCH FOUND. GO TO NEXT TABLE ENTRY.

SRCH5A:	AOS	I,PT		;NO MATCH. PT:=PT+1
	IBP	TT		;MOVE STATIC BYTE PTR
	JRST	S3		;KEEP LOOKING

FND:	CAMLE	I,Z		;REACH TOP OF BUFFER?
	JRST	NOFND		;YES. SEARCH FAILED.
	SETOM	SFINDF		;NO. SFINDF:=-1
	MOVEM	I,PT		;MOVE PT PAST THE STRING
	SOJG	E,SERCH1	;FIND IT N TIMES?
	TRZN	FF,COLONF	;YES. COLON MODIFIER?
	JRST	RET		;NO. DONE
FFOK:	MOVNI	A,1		;YES. RETURN VALUE OF -1
	JRST	VALRET
NOFND:	MOVE	I,BEG		;SEARCH FAILED
	MOVEM	I,PT		;PT:=BEG
	CLEARM	SFINDF		;SFINDF:=0
	TRNE	FF,PCHFLG+FINDR	;S SEARCH?
	JRST	NOFND1		;NO.


BEGIN1:	TRZN	FF,COLONF	;YES. COLON MODIFIER?
	JRST	NOFND2		;NO


BEGIN2:	TRZ	FF,PCHFLG+FINDR	;YES.
	JRST	BEGIN		;RETURN VALUE OF 0



NOFND1:	MOVEM	E,SRHCNT	;YES. SAVE SEARCH COUNT
	MOVEI	B,1		;PUNCH 1 PAGE ONLY
	TRNE	FF,PCHFLG	;N SEARCH?
	PUSHJ	P,PUNCHA	;YES. PUNCH THIS BUFFER AND REFILL IT.
	TLNN	FF,UREAD	;ANY INPUT FILE?
	JRST	BEGIN1		;NO
	TLNE	FF,FINF		;MORE DATA?
	TRNE	FF,FORM
	JRST	NOFND4		;YES
	MOVE	E,BEG		;EOF & NO FORM SEEN
	CAMN	E,Z		;CHECK BUFFER CONTENTS
	JRST	BEGIN1		;NO MORE DATA
NOFND4:	TRNE	FF,FINDR	;LEFT ARROW SEARCH?
	PUSHJ	P,YANK1		;YES. FILL BUFFER.
	MOVE	E,SRHCNT	;RESTORE SEARCH COUNT.
	JRST	SERCH1		;RESUME SEARCH


NOFND2:	TRNE	FF,ITERF	;IN AN ITERATION?
	JRST	BEGIN2		;YES. RETURN VALUE OF 0
	JSP	A,ERRMES
	ASCIZ	/SEARCH
/
	ERROR	^D35		;NO. SEARCH FAILED.

U SRHCNT,1			;SEARCH COUNT STORE
;CNTR S MATCHES ANY SEPARATOR CHARACTER (I.E., ANY CHARACTER NOT
;A LETTER, NUMBER, PERIOD, DOLLAR SIGN OR PER CENT SYMBOL)

CNTRB:	SKIPA	CH,[JSR P,CNTRB1]	;CH:=JSR P,CNTRB1

;CNTR X MATCHES ANY ARBITRARY CHARACTER

CNTRX:	MOVSI	CH,300000	;CH:=CAI
	JRST	SERCH4

;HERE ON CNTR N CNTR S
CNTRB2:	MOVE	A,[JRST DQT2]	;CNTRB1:=JRST DQT2
	MOVEM	A,CNTRB1
	PUSHJ	P,DQT2		;IS CH A TERMINATOR?
	JRST	SRCH5A		;NO
	JRST	SERCH5		;YES

;CNTR N REVERSES THE SENSE OF THE SEARCH FOR THE NEXT CHARACTER

CNTRN:	TRO	FF,NOTF
	JRST	SERCH2

U CNTRB1,2			;INITIALIZE TO JRST DQT2
				;INITIALIZE TO JRST CNTRB2


COLON:	TRO	FF,COLONF
	JRST	RET
;<>	ITERATION BRACKETS.  COMMAND INTERPRETATION IS SENT
;	BACK TO THE < WHEN THE > IS ENCOUNTERED.

LSSTH:	AOS	INTDPH
	PUSH	P,ITERCT	;SAVE ITERATION COUNT
	PUSH	P,CPTR		;SAVE COMMAND STATE
	PUSH	P,COMCNT
	SETOM	ITERCT		;ITERCT:=-1
	TRZN	FF,ARG		;IS THERE AN ARGUMENT?
	JRST	LSSTH1		;NO
	SKIPG	B		;ARG>0?
	ERROR	^D49		;NO
	MOVEM	B,ITERCT	;YES. ITERCT:=ARGUMENT
	JRST	LSSTH1


GRTH:	SKIPG	INTDPH		;IS THERE A LEFT ANGLE BRACKET?
	ERROR	^D38		;NO.
	TRZ	FF,ITERF	;YES
	SOSN	ITERCT		;ITERCT:=ITERCT-1. DONE?
	JRST	INCMA2		;YES
	MOVE	A,-1(P)		;NO. RESTORE COMMAND STATE TO START OF ITERATION.
	MOVEM	A,CPTR
	MOVE	A,(P)
	MOVEM	A,COMCNT
	TRNE	FF,TRACEF	;TRACING?
	PUSHJ	P,CRR		;YES. OUTPUT CRLF


LSSTH1:	TRO	FF,ITERF
	JRST	RET

U ITERCT,1			;
U INTDPH,1			;
U SFINDF,1			;
;;	IF NOT IN AN ITERATION, GIVES ERROR.  IF IN AN ITERATION AND
;	IF THE MOST RECENT SEARCH FAILED, SEND COMMAND TO FIRST UNMATCHED
;	> TO THE RIGHT.  OTHERWISE, NO EFFECT.

SEMICL:	TRNN	FF,ITERF	;IN < > ?
	ERROR	^D39		;NO. LOSE.
	TRNN	FF,ARG		;YES. IF NO ARG,
	MOVE	B,SFINDF	;USE LAST SEARCH SWITCH (0 OR -1).

INCMA:	JUMPL	B,CD		;IF ARG <0, JUST RET + EXECUTE LOOP
	MOVEI	A,0		;INIT COUNT OF <>
INCMA1:	PUSHJ	P,SKRCH1	;GET A CHAR
	CAIN	CH,"<"		;<?
	AOJA	A,INCMA1	;YES. COUNT AND LOOP.
	CAIE	CH,">"		;>?
	JRST	INCMA1		;NO. LOOP.
	SOJGE	A,INCMA1	;YES. LOOP IF MORE TO GO. COUNT.


INCMA2:	SOS	INTDPH		;POP OUT A LEVEL
	SUB	P,[XWD 2,2]
	POP	P,ITERCT
	JRST	RET



;!TAG!	TAG DEFINITION.  THE TAG IS A NAME FOR THE LOCATION IT
;	APPEARS IN IN A MACRO, ITERATION OR COMMAND STRING.

EXCLAM:	PUSHJ	P,SKRCH		;EXCLAM JUST INCREMENTS PAST ANOTHER !
	CAIE	CH,"!"
	JRST	.-2
	JRST	RET
;OTAG$	GO TO THE TAG NAMED TAG.  THE TAG MUST APPEAR IN THE 
;	CURRENT MACRO OR COMMAND STRING.

OG:	MOVE	A,CPTR
	MOVE	AA,A
	IDIVI	AA,17
	CAMN	A,SYMS(B)
	JRST	OGFND
	SKIPN	SYMS(B)
	JRST	OGNF
	CAMN	A,SYMS+1(B)

ES1:	AOJA	B,OGFND
	SKIPN	SYMS+1(B)
ES2:	AOJA	B,OGNF
	CAMN	A,SYMS+2(B)
	AOJA	B,ES1
	SKIPN	SYMS+2(B)
	ADDI	B,2

OGNF:	PUSH	P,CPTR
	PUSH	P,B
	MOVEI	D,STAB+1
	MOVEI	A,41
	MOVEM	A,-1(D)		;STAB_"!"
	PUSHJ	P,SKRCH
	MOVEM	CH,(D)		;STAB+1 ... _ TAG
	CAIE	CH,175
	AOJA	D,.-3
	MOVEM	A,(D)		;ALTMODE: STAB+N_"!"
	MOVE	B,COMCNT
	SUB	B,COMAX		;# REMAINING COMMANDS
	IDIVI	B,5
	ADD	B,CPTR		;MAKE A COMMAND POINTER
	JUMPE	E,OG2
	SOS	B
	MOVMS	E
	JRST	.(E)
	IBP	B
	IBP	B
	IBP	B
	IBP	B
OG2:	MOVE	AA,COMAX	;ALL COMMANDS
OG4:	MOVEM	B,CPTR
	MOVEM	AA,COMCNT
	MOVEI	E,STAB		;INIT SEARCH STRING TO "!"
OG5:	CAIN	E,1(D)		;OVER STRING?
	JRST	OG3		;YES
	PUSHJ	P,SKRCH1	;NO. GET A CHAR
	CAMN	CH,(E)		;MATCH ?
	AOJA	E,OG5		;YES. MOVE ON.
	IBP	B		;NO. TRY A NEW STARTING PT
	SOJA	AA,OG4		;COUNT DOWN COMMANDS




OG3:	POP	P,A
	POP	P,SYMS(A)
	MOVEM	AA,CNTS(A)
	MOVEM	B,VALS(A)
	JRST	RET


OGFND:	MOVE	A,VALS(B)
	MOVEM	A,CPTR
	MOVE	A,CNTS(B)
	MOVEM	A,COMCNT
	JRST	RET
;N"G	HAS NO EFFECT IF N IS GREATER THAT 0.  OTHERWISE,
;	SEND COMMAND INTERPRETATION TO NEXT MATCHING '.
;	THE " AND ' MATCH SIMILAR TO ( AND ).
;N"L	SEND COMMAND TO MATCHING ' UNLESS N<0.
;N"N	SEND COMMAND TO MATCHING ' UNLESS N NOT = 0.
;N"E	SEND COMMAND TO MATCHING ' UNLESS N=0.
;N"C	SEND COMMAND TO MATCHING ' UNLESS THE VALUE OF N AS AN ASCII
;	CHARACTER IS A LETTER, NUMBER, PERIOD (.), DOLLAR SIGN ($),
;	OR PER CENT (%).

DQUOTE:	TRNN	FF,ARG
DQE:	ERROR	^D40
	PUSHJ	P,RCH
	TRZ	CH,40
	MOVSI	A,0
	CAIN	CH,"G"
	MOVSI	A,327000+B*40	;A:=JUMPG B,
	CAIN	CH,"L"
	MOVSI	A,321000+B*40	;A:=JUMPL B,
	CAIN	CH,"N"
	MOVSI	A,326000+B*40	;A:=JUMPN B,
	CAIN	CH,"E"
	MOVSI	A,322000+B*40	;A:=JUMPE B,
	CAIN	CH,"C"
	JRST	DQT1
	JUMPE	A,DQE
	HRRI	A,RET
	XCT	A

NOGO:	MOVEI	A,0		;NOGO INCREMENTS COMMAND POINTER OVER
				;A SINGLE QUOTE,SKIPPING PAIRS OF " & '.
	PUSHJ	P,SKRCH1
	CAIN	CH,42		;DOUBLE QUOTE
	AOJA	A,.-2
	CAIN	CH,"'"		;SINGLE QUOTE
	SOJL	A,RET
	JRST	.-5
DQT1:	PUSHJ	P,DQT3
	JRST	RET
	JRST	NOGO

DQT2:	MOVE	B,CH

;ROUTINE TO TEST CHARACTER FOR $,%,.,0-9,A-Z
;CALL	MOVE B,CHARACTER
;	PUSHJ P,DQT3
;	RETURN IF $,%,.,0-9,A-Z
;	RETURN ON ALL OTHER CHARACTERS

DQT3:	CAIE	B,"$"		;$ OR %?
	CAIN	B,"%"
	POPJ	P,		;YES
	CAIN	B,"."		;NO. POINT?
	POPJ	P,		;YES.
	CAIGE	B,"0"		;NO. DIGIT OR LETTER?
	JRST	POPJ1		;NO
	CAIG	B,"9"		;MAYBE. DIGIT?
	POPJ	P,		;YES.
	CAIGE	B,"A"		;NO. LETTER?
	JRST	POPJ1		;NO.
	CAIG	B,"Z"
	POPJ	P,		;YES.
	CAIL	B,141		;LOWER CSE LETTERS?
	CAIL	B,173		;..
POPJ1:	AOS	0(P)		;NO.
	POPJ	P,
REPEAT 0,<

XIII.	ERRORS

	IT	IS CONCEDED THAT TECO'S ERROR MESSAGES ARE NOT OVERLY
INFORMATIVE.  FOR ALL ILLEGAL OR MEANINGLESS COMMANDS TECO TYPES OUT
? AND IGNORES THE REMAINDER OF THE COMMAND STRING, RETURNING TO THE
IDLE STATE.  AT THIS POINT THE USER MAY TYPE ? BACK IN, AND TECO
WOULD THEN RESPOND BY TYPING OUT 10 CHARACTERS OF THE COMMAND STRING,
ENDING WITH THE BAD COMMAND.  SEARCH COMMANDS ARE "BAD" IF THEY FAIL AND
THE : MODIFIER WAS NOT USED.

>


ERRTYP:	MOVE	AA,ERR2		;VALUE OF CPTR WHEN LAST ERROR OCCURRED.
	MOVEI	B,12
	SUBI	AA,2		;BACK POINTER UP 10 CHARACTERS.
	ILDB	CH,AA		;GET CHARACTER
	CAMG	B,ERR1		;WAS IT IN THE COMMAND BUFFER?
	PUSHJ	P,TYO		;YES. TYPE IT.
	CAME	AA,ERR2		;HAVE WE REACHED THE BAD COMMAND?
	SOJA	B,.-4		;NO. DO IT AGAIN.
	ERROR	^D41		;YES. TYPE ? CRLF AND WAIT FOR NEXT COMMAND.

ERRP:	HRRZ	B,40		;GET ERROR NUMBER
ERR:	MOVEI	CH,"?"		;TYPE ? CRLF
	PUSHJ	P,TYO
	PUSHJ	P,PRNT9		;PRINT ERROR NUMBER
	TRO	FF,QMFLG	;SET ? FLAG.
	MOVE	A,COMAX
	SUB	A,COMCNT
	MOVEM	A,ERR1		;ERR1:=COMAX-COMCNT
	MOVE	A,CPTR
	MOVEM	A,ERR2		;ERR2:=CPTR
	JRST	GO		;GET NEXT COMMAND



U ERR1,1			;
U ERR2,1			;

ERRA:	ERROR	^D42
;UUO HANDLER
;HALTS ON UNDEFINED UUO
;CALL	TYPR1	X
;PRINTS STRING AT X TERMINATED BY ! AND REINITIALIZES AT GOZ.

UUOH:	IFE R,<0>
	HLRZ	B,40
	CAIN	B,31000		;ERROR UUO?
	JRST	ERRP		;YES
	CAIE	B,30000		;TYPR1?
	TYPR1	XXTY01		;NO. OOPS
	HRLZI	B,440700	;YES. ADDRESS POINTS TO MESSAGE TERMINATED BY !
	HRR	B,40
UUOH2:	ILDB	CH,B
	JUMPE	CH,GOX		;END OF MESSAGE? IF YES. REINITIALIZE
	PUSHJ	P,TYO		;NO. PRINT A CHARACTER
	JRST	UUOH2

U LISTF5,1			;OUTPUT DISPATCH



XXTY01:	ASCIZ	/?LOC 40 DAMAGED
/
XXTY02:	ASCIZ	/?GC ERROR
/
;COMMAND TO COMPLEMENT TRACE MODE. "?" AS A COMMAND

QUESTN:	MOVE	A,[JRST TYO]
	TRCE	FF,TRACEF
	MOVSI	A,263000+P*40	;TRACS:=POPJ P,
	MOVEM	A,TRACS
	JRST	RET

COMMEN:	PUSHJ	P,SKRCH		;GET A COMMENT CHAR
	CAIN	CH,1		;^A
	POPJ	P,		;DONE
	PUSHJ	P,TYO		;TYPE IT
	JRST	COMMENT


CALDDT:	SKIPE	T,JOBDDT
	JRST	(T)
	ERROR	^D43
;ROUTINE TO RETURN STRING OPERATION STRING ARGUMENTS.
;ARGUMENTS ARE CHARACTER ADDRESSES IN THE DATA BUFFER.
;TRANSFORMS M,N OR N, WHERE THE LATTER SPECIFIES A NUMBER OF LINES,
;TO ARGUMENTS.
;CALL	PUSHJ P,GETARG
;	RETURN WITH FIRST ARGUMENT ADDRESS IN C, SECOND IN B.


GETARG:	TRNE	FF,ARG2		;IS THERE A SECOND ARGUMENT?
	JRST	GETAG6		;YES

;N	SIGN INDICATES DIRECTION RELATIVE TO PT.
	TRON	FF,ARG		;NO. IS THERE AN ARGUMENT?
	PUSHJ	P,CHK22		;NO. B:=1 IF LAST ARGUMENT FUNCTION WAS +,*,OR /
				;B:=-1, IF &,#, OR -
				;IE, ASSUME AN ARGUMENT OF 1 AND RETAIN SIGN
	MOVE	I,PT		;IN:=PT
GETAG4:	JUMPLE	B,GETAG2	;WAS LAST ARGUMENT FUNCTION -?
	CAMN	I,Z		;NO. ARGUMENT IS LOCATION OF NTH LINE
				;FEED FORWARD FROM PT.
				;IS PT AT END OF BUFFER?
	JRST	GETAG1		;YES.
	PUSHJ	P,GETINC	;NO. CH:=NEXT DATA BUFFER CHARACTER, IN:=IN+1
	CAIE	CH,12		;LINE FEED?
	JRST	GETAG4		;NO. TRY AGAIN.
	SOJG	B,GETAG4	;YES. NTH LINE FEED?

GETAG1:	MOVE	B,I		;YES. RETURN FIRST ARGUMENT IN C
	MOVE	C,PT		;SECOND IN B.
	POPJ	P,

;M,N
GETAG6:	ADD	B,BEG		;C:=M+BEG
	ADD	C,BEG		;B:=N+BEG
	POPJ	P,

GETAG2:	SOS	I		;ARGUMENT IS POSITION OF NTH LINE FEED TO LEFT OF PT.
				;N:=N-1
	CAMG	I,BEG		;PASSED BEGINNING OF BUFFER?
	JRST	GETAG3		;YES. IN:=BEG
	PUSHJ	P,GETINC	;NO. CH:=NEXT DATA BUFFER CHARACTER. IN:=IN+1
	CAIE	CH,12		;LINE FEED?
	SOJA	I,GETAG2	;NO. BACK UP ONE POSITION AND TRY AGAIN.
	AOJLE	B,.-1		;YES. NTH LINE FEED?

GETAG3:	CAMGE	I,BEG		;YES. PASSED BEGINNING OF BUFFER?
	MOVE	I,BEG		;YES. RESET TO BEGINNING.
	MOVE	C,I		;NO. RETURN FIRST ARGUMENT IN C.
	MOVE	B,PT		;SECOND IN B
	POPJ	P,
;ROUTINE TO RETURN IN CH THE CHARACTER TO THE RIGHT OF THE POINTER
;AND INCREMENT THE POINTER.
;CALL	MOVE I,POINTER (AS A CHARACTER ADDRESS)
;	PUSHJ P,GETINC
;	RETURN WITH CHARACTER IN CH AND POINTER TO CHARACTER IN IN.

GETINC:	PUSHJ	P,GET
	AOJA	I,CPOPJ

GET:	MOVE	TT,I
	IDIVI	TT,5
	HLL	TT,BTAB(TT1)
	LDB	CH,TT
	POPJ	P,

PUT:	MOVE	TT,OU
	IDIVI	TT,5
	HLL	TT,BTAB(TT1)
	DPB	CH,TT
	POPJ	P,

;CHARACTER TRANSLATION BYTE POINTER TABLE
;TRANSLATES 1 CHARACTER POSITION TO THE RIGHT OF A CHARACTER ADDRESS POINTER

BTAB:	XWD	350700,0
	XWD	260700,0
	XWD	170700,0
	XWD	100700,0
	XWD	10700,0




TYOM:	PUSH	P,C		;TYO TO MEMORY
	PUSH	P,OU
	PUSH	P,TT
	PUSH	P,TT1
	PUSHJ	P,TAB2
	POP	P,TT1
	POP	P,TT
	POP	P,OU
	POP	P,C
	POPJ	P,
NROOM:	MOVEM	17,AC2+15	;SAVE 17
	MOVEI	17,NROOM9	;ANTICIPATE GARBAGE COLLECTION
	MOVEM	17,GCRET	;THIS THE EXIT DISPATCH
	MOVE	17,PT
	CAMN	17,Z		;PT=Z? I.E., DATA BUFFER EXPANSION?
	JRST	NROOM1		;YES.
NROOM0:	MOVE	17,[XWD 2,AC2]	;NO. SAVE ACS 2 THROUGH 16.
	BLT	17,AC2+14
	JUMPL	C,NROOM6	;DELETION?
	SETOM	GCFLG		;NO.
	CLEARM	CRREL
	CLEARM	RREL

;MOVE STRING STORAGE UP C CHARACTERS STARTING AT PT.

NROOM9:	MOVE	17,Z
	ADD	17,C
	CAML	17,MEMSIZ	;WILL REQUEST OVERFLOW MEMORY?
	JRST	GC		;YES. GARBAGE COLLECT.
;MOVE FROM PT THROUGH Z UP C POSITIONS
	MOVE	14,C		;NO.
	IDIVI	14,5		;AC14:=Q(REQ/5), AC15:=REM(REQ/5)
	IMULI	15,7		;AC15:=(REM(REQ/5))*7
	MOVN	13,15		;AC13:=-(REM(REQ/5))*7
	MOVEI	15,-43(15)	;AC15:=(REM(REQ/5))*7-43
	MOVE	11,PT
	IDIVI	11,5		;AC11:=Q(PT/5), AC12:=REM(PT/5)
	MOVNI	16,-5(12)
	IMULI	16,7		;AC16:=-(REM(PT/5)-5)*7
	DPB	16,[XWD 300600,NROOM2]	;SET SIZE FIELD OF LAST PARTIAL WORD POINTER.
	ADDI	14,1(11)	;AC14:=Q(REQ/5)+Q(PT/5)+1
	MOVE	16,Z
	IDIVI	16,5		;AC16:=Q(Z/5)
	MOVEI	B,1(16)
	SUB	B,11		;B:=Q(Z/5)+1-Q(PT/5)=NO. OF WORDS TO MOVE.
;PUT MOVE ROUTINE IN FAST ACS
	HRLI	11,200000+B+A*40	;AC11:=MOVE A,[Q(PT/5)](B)
	HRLOI	12,241000+A*40	;AC12:=ROT A,-1
	HRLI	13,245000+A*40	;AC13:=ROTC A,-(REM(REQ/5))*7
	HRLI	14,202000+B+AA*40	;AC14:=MOVEM AA,[Q(PT/5)+1](B)
	HRLI	15,245000+A*40	;AC15:=ROTC A,(REM(REQ/5))*7-43
	MOVE	17,[JRST,NROOM7]	;AC16:=SOJGE B,11
	MOVE	16,.+1		;AC17:=JRST NROOM7
	SOJGE	B,11		;B:=B-1. DONE?
NROOM7:	ROTC	A,43(13)	;YES. STORE LAST PARTIAL WORD.
	DPB	A,NROOM2
	ADDM	C,Z		;Z:=Z+REQ
NROOM5:	MOVE	17,[XWD 2,AC2]	;RESTORE ACS AND RETURN.
	MOVSS	17
	BLT	17,17
	POPJ	P,


U NROOM2,1			;POINTER TO LAST PARTIAL WORD ON UPWARD MOVE.
;A CALL FOR A BUFFER EXPANSION, WHERE PT=Z. IF
;THERE IS NOT ENOUGH ROOM, PERFORM THE GARBAGE COLLECTION ROUTINE
;IF THERE IS STILL NO ROOM, GET THE NECESSARY CORE FROM THE 
;MONITOR TO SATISFY THIS REQUEST

NROOM1:	ADD	17,C		;TOTAL SPACE REQUIREMENT
	CAMG	17,MEMSIZ	;IS THERE ENOUGH?
	JRST	.+4		;YES, THEREFORE, UPDATE Z AND EXIT
	MOVEI	17,GCRETA	;EXIT DISPATCH FOR THE
	MOVEM	17,GCRET	;GARBAGE COLLECTION ROUTINE
	JRST	NROOM0		;GO DO THE GARBAGE COLLECTION
	ADDM	C,Z		;UPDATE Z, SIZE IS OK
	MOVE	17,AC2+15	;RESTORE AC#17
	POPJ	P,		;EXIT OUT


;NOT ENOUGH ROOM FOR THE EXPANSION, GARBAGE COLLECTION HAS BEEN
;PERFORMED, IF NEED BE, GRAB A K FROM THE MONITOR (OR MORE)

GCRETA:	MOVE	17,Z		;GET TOTAL SO FAR
	ADD	17,C		;ADD IN THE REQUEST
	CAML	17,MEMSIZ	;STILL IN NEED OF CORE?
	PUSHJ	P,GRABAK	;YES, GET THE REQUIRED CORE FROM THE MONITOR
	ADDM	C,Z		;UPDATE Z AND EXIT
	JRST	NROOM5		;RESTORE ALL AC'S AND RETURN TO SEQUENCE

U GCRET,1			;GC EXIT DISPATCH
;MOVE FROM PT+ABS(C) THROUGH Z DOWN ABS(C) POSITIONS
NROOM6:	MOVE	14,PT		;INITIALIZE PARTIAL WORD POINTER.
	IDIVI	14,5		;AC14:=Q(PT/5), AC15:=REM(PT/5)
	MOVEM	14,B		;B:=Q(PT/5)
	HRRM	14,NROOM4
	IMULI	15,7
	DPB	15,[XWD 300600,NROOM4]	;SIZE:=(REM(PT/5))*7
	MOVNI	15,-44(15)
	DPB	15,[XWD 360600,NROOM4]	;POSITION:=44-(REM(PT/5))*7
	MOVE	11,Z
	IDIVI	11,5		;AC11:=Q(Z/5)+1, AC12:=REM(Z/5)
	ADDI	11,1
	MOVE	13,C
	IDIVI	13,5
	ADDI	13,-1(11)	;AC13:=Q(Z/5)-Q(REQ/5)
	MOVNM	14,12		;AC12:=(REM(REQ/5))*7
	IMULI	12,7
	MOVNI	15,-43(12)	;AC15:=43-(REM(REQ/5))*7
	SUBI	B,1(13)		;B:=Q(PT/5)+Q(REQ/5)-Q(Z/5)-1:=# WORDS TO MOVE

NROOM8:	HRLI	11,200000+B+AA*40	;AC11:=MOVE AA,[Q(Z/5)+1](B)
	HRLI	12,245000+A*40	;AC12:=ROTC A,(REM(REQ/5))*7
	HRLI	13,202000+B+A*40	;AC13:=MOVEM A,[Q(Z/5)-Q(REQ/5)](B)
	MOVE	14,[ADDM A,@13]	;AC14:=ADDM A,@13
	HRLI	15,245000+A*40	;AC15:=ROTC A,43-(REM(REQ/5))*7
	MOVE	17,[JRST NROOM3]	;AC16:=AOJLE B,11
	ADDM	C,Z		;AC17:=JRST NROOM3
	LDB	C,NROOM4
	MOVE	A,@11		;Z:=C(Z)-REQ
	ROT	A,-1		;A:=Q(PT/5)+Q(REQ/5) RIGHT JUSTIFIED.
	MOVE	16,.+1
	AOJLE	B,11		;B:=B+1.  DONE?

NROOM3:	DPB	C,NROOM4	;YES. DEPOSIT PARTIAL WORD.
	JRST	NROOM5

U NROOM4,1			;PARTIAL WORD POINTER FOR DOWNWARD MOVE
GC:	AOSE	GCFLG		;FIRST ATTEMPT?

GC1:	JRST	PRENR9		;TRY TO EXPAND MEMORY

	SETOM	GCPTR		;YES. GCPTR:=-1
	CLEARM	SYMS		;CLEAR SYMS,VALS AND CNTS TABLES
	MOVE	T,[XWD SYMS,SYMS+1]
	BLT	T,SYMEND-1
	MOVEI	T,CPTR		;COMMAND BUFFER
	PUSHJ	P,GCMA
	HRRZ	T,P
	SUBI	T,
	CAIL	T,PDL		;PUSHDOWN LIST EMPTY?
	PUSHJ	P,GCMA		;NO. GARBAGE COLLECT ALL BYTE POINTERS ON IT.
	CAILE	T,PDL
	SOJA	T,.-2
	HRRZ	T,AC2+PF-2	;GARBAGE COLLECT Q-REG PUSHDOWN LIST.
	CAIL	T,PFL
	PUSHJ	P,GCM
	CAILE	T,PFL
	SOJA	T,.-2
	MOVE	T,[XWD -44,QTAB]	;GARBAGE COLLECT Q-REGISTERS.
	PUSHJ	P,GCM
	AOBJN	T,.-1
	SKIPGE	GCPTR		;ANYTHING TO COLLECT?
	JRST	@ GCRET		;NOPE.
GCS:	MOVE	I,QRBUF
GCS1A:	MOVSI	TT,1*5		;TT>MAX. NO. CHARACTERS IN WORLD
	MOVE	OU,GCPTR	;GO BACKWARDS THROUGH GCTAB
GCS1:	HRRZI	A,GCTAB(OU)	;RELOCATE
	HRRZ	A,@A
	ADD	A,QRBUF
	CAMGE	A,I
	JRST	GCS2
	CAMGE	A,TT		;SET TT TO HIGHEST CHARACTER POSITION
	MOVE	TT,A
GCS2:	SOJGE	OU,GCS1
	TRNN	TT,-1		;ANYTHING TO COLLECT?
	JRST	@ GCRET		;NOPE.
	MOVE	F,TT		;HIGHEST CHARACTER.
	IDIVI	I,5		;C(QRBUF)/5
	IDIVI	F,5		;HIGH CHAR/5
	AOS	I		;C(QRBUF)/5+1
	MOVS	OU,F
	MOVE	T,F
	SUB	T,I		;HIGH CHAR/5-C(QRBUF)/5+1
	JUMPLE	T,GCS4A		;ANYTHING TO GET?
	HRR	OU,I		;XWD HIGH CH/5,HIGH CH/5-C(QRBUF)/5+1=NREG
	MOVE	B,Z
	IDIVI	B,5
	SUB	B,T		;Z/5-NREG
	HRLI	B,0
	BLT	OU,@B		;MOVE STUFF DOWN
	MOVNS	OU,T
	IMULI	OU,5		;OUT:=-5*NREG
	ADDM	OU,BEG		;BEG:=C(BEG)-5*NREG
	ADDM	OU,PT		;PT:=C(PT)-5*NREG
	ADDM	OU,Z		;Z:=C(Z)-5*NREG
	ADDM	OU,RREL		;RREL:=C(RREL)-5*NREG
	MOVE	CH,GCPTR	;UPDATE INSERTER
GCS3:	HRRZI	TT1,GCTAB(CH)
	HRRZ	A,@TT1
	ADD	A,QRBUF
	CAMGE	A,TT
	JRST	GCS4
	ADDM	OU,@TT1
	HLRZ	A,@TT1
	CAIN	A,CPTR		;IN COMMAND BUFFER?
	ADDM	OU,CRREL	;YES. UPDATE COMMAND POINTER RELOCATION
	HRLI	A,0
	SKIPL	@A		;Q-REG?
	ADDM	T,@A		;NO
	SKIPGE	@A		;Q-REG?
	ADDM	OU,@A		;YES. RELOCATE BASE POINTER.

GCS4:	SOJGE	CH,GCS3		;DONE?
	ADD	TT,OU		;YES. IN:=C(TT)-5*NREG

GCS4A:	MOVE	I,TT		;I SHOULD POINT TO AN END OF STRING FLAG (141)
	PUSHJ	P,GETINC
	CAIE	CH,141

GCERR:	TYPR1	XXTY02		;STRANGE LOSS

	PUSHJ	P,GETINC
	MOVE	A,CH
	PUSHJ	P,GETINC
	ROT	CH,7
	IOR	A,CH
	ADDI	I,-3(A)
	JRST	GCS1A
GCM:	MOVE	I,(T)
	TLZE	I,400000	;DOES Q-REG CONTAIN TEXT?
	TLZE	I,377777
	POPJ	P,		;NO
	ADD	I,QRBUF		;YES. ENTER POINTER IN GCTAB

GCM2:	CAML	I,BEG		;REGION BEFORE TEXT BUFFER?
	POPJ	P,		;NO. FORGET IT.
	PUSHJ	P,GET		;YES. CHECK FOR MARK.
	CAIE	CH,141		;END OF STRING?
	POPJ	P,		;NO.
	SUB	I,QRBUF		;YES. IN:=# CHARACTERS TO RETREIVE.
				; IN Q-REG BUFFER AREA?
	JUMPL	I,CPOPJ		;NO. FORGET IT.
	AOS	TT,GCPTR	;YES. TO BE GRABBED.
	CAIL	TT,GCTBL	;AM I WINNING?
	JRST	GCERR		;NO. VERY BAD.
	HRL	I,T		;XWD ADDRESS OF BYTE POINTER,NO. CHARACTERS
	ADDI	TT,GCTAB	;RELOCATE
	HRLI	TT,0
	MOVEM	I,@TT		;SAVE DATA
	POPJ	P,		;DONE THIS POINTER

;IF T POINTS TO AN ASCII BYTE POINTER, IN:=CHARACTER ADDRESS OF TOP
;OF STRING - NO. OF CHARACTERS.
GCMA:	HRRZ	TT1,T
	LDB	TT,[XWD 221420,TT1]	;BYTE SIZE + XR
	TRC	TT,700		;DOES T POINT TO A TEXT BYTE POINTER?
	TRCE	TT,700
	POPJ	P,		;NO
	SOS	TT1
	MOVE	I,@TT1		;MAYBE. GET WORD BEFORE POINTER. (MAX)
	ADDI	TT1,2
	SUB	I,@TT1		;MAX-CT
	SOS	TT1
	LDB	TT,[XWD 360620,TT1]	;BYTE POSITION
	IDIVI	TT,7		;NO. OF CHARACTERS
	MOVEI	TT1,4-3+1	;2
	SUB	TT1,TT		;2-NO. OF CHARACTERS
	HRRZ	TT,(T)		;POINTER WORD ADDRESS (UNRELOCATED)
	IMULI	TT,5		;5*ADDRESS
	ADD	TT,TT1
	SUBM	TT,I		;5*ADDRESS-NO. CHARS+2+MAX-CT
	JRST	GCM2
;**********AUTOMATIC MEMORY EXPANSION*********

;MEMORY WILL BE EXPANDED UNDER ONE OF THESE CONDITIONS.

;	1.AN INTERNAL BUFFER EXPANSION CANNOT BE PERFORMED,
;	  TO DO SO WOULD OVERFLOW THE PRESENT MEMORY
;	  CAPACITY. THE INTERNAL OPERATIONS WHICH DESCOVER
;	  THE NEED FOR EXPANSION ARE:

;	  A.COMMAND BUFFER EXPANDING
;	  B.THE Q-REG GET (GI)
;	  C.THE Q-REG LOAD (NXI)
;	  D.ANY OF THE INSERTS
;	  E.COMMAND ACCEPTANCE ROUTINE


;	2.THE DATA BUFFER WILL BE MAINTAINED AT A MINIMUM
;	  NUMBER OF 5000 CHARACTERS BEFORE NEW DATA IS LOADED
;	  FROM AN INPUT DEVICE OTHER THAN THE CONSOLE. Q-REG
;	  USAGE SHORTENS THE NUMBER OF AVAILABLE CHARACTERS
;	  DIRECTLY, AND NORMAL TECO COMMANDS ARE GREATLY IMPARED
;	  OTHERWISE.


;SAVE THE ACCUMULATORS


GRABAK:	TLOA	FF,GKTLKF	;TALKATIVE GRAB
GRABKQ:	TLZ	FF,GKTLKF	;GRAB A K QUIETLY
	MOVEM	CH,SAV16	;TO SAVE THE ACCUMULATORS
	MOVEI	CH,SAVE		;WHILE WE SCOOT ALL OVER THE
	BLT	CH,SAV16-1	;THE PLACE

;COUNT THE NUMBER OF BLOCKS NEEDED TO FILL THE REQUEST

	MOVEI	F,^D1024	;1 BLOCK OF CORE
	MOVEI	B,1		;WE WILL NEED AT LEAST ONE BLOCK
	ADDM	F,JOBFF		;UP THE FIRST FREE COUNT
	PUSHJ	P,CRE23		;COMPUTE A NEW MEMSIZ AND 2/3 VALUE
	CAML	17,MEMSIZ	;WILL THIS BE ENOUGH CORE?
	AOJA	B,.-3		;NO, COMPUTE ANOTHER BLOCK
;NUMBER OF BLOCKS HAVE BEEN FOUND
;OBTAIN THE NEEDED CORE FROM THE MONITOR

	MOVE	B,JOBFF		;TO HELP OUT THE MONITOR
	CALLI	B,CORE		;MAKE THE CALL TO THE MONITOR
	JRST	NOTANY		;NO CORE (OR NOT ENOUGH) AVAILABLE
	TLNN	FF,GKTLKF	;MESSAGE DESIRABLE?
	JRST	EXITZ		;NO
	MOVEI	CH,"["
	PUSHJ	P,TYO
	MOVEI	A,TYO
	HRRM	A,LISTF5	;SET OUTPUT TO TTY
	MOVE	B,JOBREL	;SIZE OF CORE NOW
	ADDI	B,1
	ASH	B,-12
IFN R,	<ADDI	B,HITOP>	;IF SHARABLE VERSION, ADD HICORE TO TYPEOUT
	PUSHJ	P,DPT
	JSP	A,CONMES
	ASCIZ	/K CORE]
/

;RESTORE THE AC'S AND EXIT FROM THIS COR GET ROUTINE

EXITZ:	MOVSI	CH,SAVE		;FROM TO
	BLT	CH,CH		;ALL AC'S AS THEY WERE
	POPJ	P,		;AND EXIT

;NO CORE AVAILABLE (OR NOT ENOUGH)

NOTANY:	JSP	A,CONMES	;INFORM THE OUTSIDE WORLD THAT THEY LOOSE
	ASCIZ	/?STORAGE CAPACITY EXCEEDED
/
	HLRZ	A,JOBSA		;GET LAST FIGURE OF CORE BOUND
	MOVEM	A,JOBFF		;AND STORE IT
	PUSHJ	P,CRE23		;COMPUTE THE MEMSIZE VALUES AGAIN
	MOVSI	CH,SAVE		;RESTORE THE ACCUMULATORS AS THEY WERE
	BLT	CH,CH		;BEFORE THE ERROR EXIT
	ERROR	^D44		;TYPE THE ? MARK

;THIS IS AN AUXILARY SPOT FOR ENTRANCE FROM GC2
;GET THE REQUIRED CORE TO SAVE THE JOB IF POSSIBLE

PRENR9:	PUSHJ	P,GRABAK	;GET THE REQUIRED CORE
	JRST	NROOM9		;GO TRY THE INSERT AGAIN
U BEG,1				;
U PT,1				;
U Z,1				;
U QRBUF,1			;
;*** DO NOT SEPARATE ***
U COMAX,1			;
U CPTR,1			;
U COMCNT,1			;
;*** DO NOT SEPARATE ***
U CBUFH,1			;
U MEMSIZ,1			;
IFN CCL,<U CCLSW,1>
U GCPTR,1			;
U CRREL,1			;
U GCFLG,1			;
U RREL,1			;


;CORRECT FOR 2/3 BUFFER FILLING ERROR.M23 IS 2/3'S AND M23PL IS 2/3
;PLUS THE OTHER THIRD-128 CHARACTERS.

U M23,1				;
U M23PL,1			;
;COMMAND DISPATCH TABLE
;DISPATCH IS BY XCT OF INSTRUCTION CONSTRUCTED FROM THIS TABLE
;FORMAT:
;	MOVEI A,X	;IF X RETURNS A VALUE
;	HRROI A,X	;IF X DOES NOT RETURN A VALUE AND EXITS WITH POPJ
;	JRST X		;IF X DOES NOT RETURN A VALUE AND EXITS TO A
;			;FIXED LOCATION.

DEFINE	DSP (C1,A1,C2,A2)<
	XWD <<C1>B20+A1>,<<C2>B20+A2>>

;CODES
JR==0	;FOR JRST X
HR==1	;FOR HRROI A,X
MV==2	;FOR MOVEI A,X

DTB:
	DSP(HR,ERRA,HR,COMMEN)	;^@	^A
	DSP(HR,ERRA,HR,ERRA)	;^B	^C
	DSP(MV,CALDDT,MV,FFEED)	;^D	^E
	DSP(MV,LAT,MV,DECDMP)	;^F	^G
	DSP(MV,GTIME,HR,TAB)	;^H	TAB
	DSP(MV,CD,HR,ERRA)	;LF	VT
	DSP(HR,TYO,MV,CD)		;FF	CR
	DSP(HR,ERRA,HR,ERRA)	;^N	^O
	DSP(HR,ERRA,HR,ERRA)	;^P	^Q
	DSP(HR,ERRA,HR,ERRA)	;^R	^S
	DSP(MV,SPTYI,HR,ERRA)	;^T	^U
	DSP(HR,ERRA,HR,ERRA)	;^V	^W
	DSP(HR,ERRA,HR,ERRA)	;^X	^Y
	DSP(HR,ERRA,MV,ALTMOD)	;^Z	^[
	DSP(HR,ERRA,HR,ERRA)	;^BKSLH	^]
	DSP(MV,CNTRUP,HR,ERRA)	;^^	^LFTARR
	DSP(MV,CD2,MV,EXCLAM)	;SPACE	!
	DSP(MV,DQUOTE,MV,COR)	;"	#
	DSP(HR,ERRA,MV,PCNT)	;$	%
	DSP(MV,CAND,MV,CD)	;&	'
	DSP(MV,OPEN,MV,CLOSE)	;(	)
	DSP(MV,TIMES,MV,CD2)	;*	+
	DSP(MV,COMMA,MV,MINUS)	;,	-
	DSP(MV,PNT,MV,SLASH)	;.	/
	DSP(JR,CDNUM,JR,CDNUM)	;0	1
	DSP(JR,CDNUM,JR,CDNUM)	;2	3
	DSP(JR,CDNUM,JR,CDNUM)	;4	5
	DSP(JR,CDNUM,JR,CDNUM)	;6	7
	DSP(JR,CDNUM,JR,CDNUM)	;8	9
	DSP(MV,COLON,MV,SEMICL)	;:	;
	DSP(MV,LSSTH,HR,PRNT)	;<	=
	DSP(MV,GRTH,MV,QUESTN)	;>	?
	DSP(MV,ATSIGN,JR,ACMD)	;@	A
	DSP(MV,BEGIN,MV,CHARAC)	;B	C
	DSP(MV,DELETE,HR,ECMD)	;D	E
	DSP(JR,CD,MV,QGET)	;F	G
	DSP(MV,HOLE,HR,INSERT)	;H	I
	DSP(MV,JMP,MV,KILL)	;J	K
	DSP(MV,LINE,JR,MAC)	;L	M
	DSP(MV,SERCHP,MV,OG)	;N	O
	DSP(HR,PUNCH,MV,QREG)	;P	Q
	DSP(MV,REVERS,MV,SERCH)	;R	S
	DSP(HR,TYPE,MV,USE)	;T	U
	DSP(HR,ERRA,MV,CD)	;V	W
	DSP(MV,X,HR,YANK)		;X	Y
	DSP(MV,END1,MV,OPENB)	;Z	[
	DSP(MV,BAKSL,MV,CLOSEB)	;BKSLH	]
	DSP(MV,UAR,MV,LARR)	;^	LFTARR
	DSP(MV,ALTMOD,MV,ALTMOD)	;ALT	176
	DSP(HR,ERRA,0,0)		;RUBOUT
U STAB,0			;SEARCH TABLE
				;SERCH4+2,OGNF+4,OGNF+6,OGFN+11
U AC2,16			;SAVE AC2-AC17 IN NROOM ROUTINE
				;NROOM,NROOM5
U BAKTAB,40-3-16		;RECEIVES ASCII CONVERSION OF NUMERICAL ARGUMENT
				;BAKSL4

CFIL1=STAB
CFIL2=STAB+1
U STABP,0			;
U SYMS,22			;LIS+4(0),OG3+1,GC+3(0)
U VALS,22			;LIS+4(0),OG3+3,GC+3(0)
U CNTS,22			;LIS+4(0),OG3+2,GC+3(0)
U SYMEND,0			;
U PFL,LPF			;
U GCTAB,GCTBL			;GCS3+4,GCM2+13
U QTAB,45			;Q-REGISTER TABLE
				;USEA+1,PCNT+1
QTABE=QTAB+44			;FOR CLEARING Q REGS
U PDL,LPDL			;
U UAC,17			;
PATCH:	BLOCK	10

;HERE IS STORED THE AC'S FOR THE SAVE ROUTINE

U SAVE,16			;
U SAV16,1			;
U SAV17,1			;

LIT
U CBUF,0			;
U TOP,0				;

HIEND:
TECOSTOP: END	STARTA
                                                                                                                                                                                                                                                                                                                                                                                                                                     